New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
edit <> files in place is not atomic #6177
Comments
From eperez@it.uc3m.esThe operation: If something while perl is working hangs the system like a crash or a This is what perl currently does (simplified Linux strace): Thus is the atomic approach: This way you always keep a good copy if something fails. |
From eperez@it.uc3m.esThis is the patch I'm working. Be aware it removes some features, so some tests don't pass. But this is what a working patch should look like. Could some perl core coder tell me how to fix this code? |
From eperez@it.uc3m.esperl_inplace_atomic.diff--- perl/doio.c
+++ perl/doio.c
@@ -745,87 +745,9 @@
do_close(gv,FALSE);
continue;
}
- if (*PL_inplace) {
- char *star = strchr(PL_inplace, '*');
- if (star) {
- char *begin = PL_inplace;
- sv_setpvn(sv, "", 0);
- do {
- sv_catpvn(sv, begin, star - begin);
- sv_catpvn(sv, PL_oldname, oldlen);
- begin = ++star;
- } while ((star = strchr(begin, '*')));
- if (*begin)
- sv_catpv(sv,begin);
- }
- else {
- sv_catpv(sv,PL_inplace);
- }
-#ifndef FLEXFILENAMES
- if ((PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
- && PL_statbuf.st_dev == filedev
- && PL_statbuf.st_ino == fileino)
-#ifdef DJGPP
- || ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0)
-#endif
- )
- {
- if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ packWARN(WARN_INPLACE),
- "Can't do inplace edit: %s would not be unique",
- SvPVX(sv));
- do_close(gv,FALSE);
- continue;
- }
-#endif
-#ifdef HAS_RENAME
-#if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC)
- if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
- if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %s: %s, skipping file",
- PL_oldname, SvPVX(sv), Strerror(errno) );
- do_close(gv,FALSE);
- continue;
- }
-#else
- do_close(gv,FALSE);
- (void)PerlLIO_unlink(SvPVX(sv));
- (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
- do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
-#endif /* DOSISH */
-#else
- (void)UNLINK(SvPVX(sv));
- if (link(PL_oldname,SvPVX(sv)) < 0) {
- if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %s: %s, skipping file",
- PL_oldname, SvPVX(sv), Strerror(errno) );
- do_close(gv,FALSE);
- continue;
- }
- (void)UNLINK(PL_oldname);
-#endif
- }
- else {
-#if !defined(DOSISH) && !defined(AMIGAOS)
-# ifndef VMS /* Don't delete; use automatic file versioning */
- if (UNLINK(PL_oldname) < 0) {
- if (ckWARN_d(WARN_INPLACE))
- Perl_warner(aTHX_ packWARN(WARN_INPLACE),
- "Can't remove %s: %s, skipping file",
- PL_oldname, Strerror(errno) );
- do_close(gv,FALSE);
- continue;
- }
-# endif
-#else
- Perl_croak(aTHX_ "Can't do inplace edit without backup");
-#endif
- }
- sv_setpvn(sv,">",!PL_inplace);
- sv_catpvn(sv,PL_oldname,oldlen);
+ sv_setpvn(sv,PL_oldname,oldlen);
+ sv_catpvn(sv,".new",4);
SETERRNO(0,0); /* in case sprintf set errno */
#ifdef VMS
if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
@@ -883,7 +805,37 @@
if (io && (IoFLAGS(io) & IOf_ARGV))
IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
+ STRLEN oldlen;
(void)do_close(PL_argvoutgv,FALSE);
+ /* We shouldn't get here if there where any problem (like out of space) writing the file or closing them */
+ PL_oldname = SvPVx(GvSV(gv), oldlen);
+ sv_setpvn(sv,PL_oldname,oldlen);
+ sv_catpvn(sv,".new",4);
+#ifdef HAS_RENAME
+#if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC)
+ if (PerlLIO_rename(SvPVX(sv),PL_oldname) < 0) {
+ if (ckWARN_d(WARN_INPLACE))
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
+ "Can't rename %s to %s: %s, skipping file",
+ SvPVX(sv), PL_oldname, Strerror(errno) );
+ do_close(gv,FALSE);
+ }
+#else
+ /* (void)PerlLIO_unlink(SvPVX(sv)); */ /* Don't know if this is needed, but if needed it would be not atomic, at least it wont lose data */
+ (void)PerlLIO_rename(SvPVX(sv),PL_oldname);
+#endif /* DOSISH */
+#else
+ (void)UNLINK(PL_oldname);
+ if (link(SvPVX(sv),PL_oldname) < 0) {
+ if (ckWARN_d(WARN_INPLACE))
+ Perl_warner(aTHX_ packWARN(WARN_INPLACE),
+ "Can't rename %s to %s: %s, skipping file",
+ PL_oldname, SvPVX(sv), Strerror(errno) );
+ do_close(gv,FALSE);
+ } else {
+ (void)UNLINK(SvPVX(sv));
+ }
+#endif
if (io && (IoFLAGS(io) & IOf_ARGV)
&& PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
{
|
From @jkeenanOn Sat Dec 21 10:32:12 2002, eperez wrote:
As of Perl 5.14.2, 'pods/perlrun.pod' says this about the '-i' option If no extension is supplied, no backup is made and the current file This seems to me to guarantee the atomicity the original poster was seeking. Am I correct in this conclusion? If so, then the ticket may be closed. Thank you very much. |
From PeterCMartini@GMail.comOn Thu, Nov 24, 2011 at 2:30 PM, James E Keenan via RT <
The issue is what happens if the program crashes in the middle of the 1. If the script dies any time after opening the file, the file will now I'm not sure how much detail to go into in perlrun, otherwise I'd have a * See http://perldoc.perl.org/perlcygwin.html; Windows does what the |
From @rjbsOn Sat Nov 26 23:25:16 2011, pcm wrote:
We can add this, but they're not really "perl facts" so much as "how |
From @wolfsageOn Sun Nov 27 03:49:39 2011, rjbs wrote:
I think adding the warning to perlrun.pod at least would be good so it's I realize that this really goes without saying, because if you mess up I don't think we should make backing up the data default behavior -- Matthew Horsfall (alh) |
From @jkeenanOn Sun Dec 11 15:23:08 2011, alh wrote:
rjbs, alh: Can you come to some resolution of these issues so that we can patch if Thank you very much. |
From @rjbs* James E Keenan via RT <perlbug-followup@perl.org> [2012-09-21T22:48:07]
I relent. A warning is appropriate. -- |
From @jkeenanOn Thu Sep 27 19:00:19 2012, perl.p5p@rjbs.manxome.org wrote:
alh, pcm: Can either of you submit a *brief* patch? Thank you very much. |
From PeterCMartini@GMail.comOn Thu, Sep 27, 2012 at 10:27 PM, James E Keenan via RT <
Something like this? From a09ace7d638055c4a5ecf3cce1d41de3347bfcda Mon Sep 17 00:00:00 2001 pod/perlrun.pod | 6 ++++-- Inline Patchdiff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 9ed678c..1f32cd5 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -506,8 +506,10 @@ default for print() statements. The extension, if
-If no extension is supplied, no backup is made and the current file is If the extension doesn't contain a C<*>, then it is appended to the
|
From @cpansproutOn Mon Oct 08 19:47:55 2012, pcm wrote:
Good enough for me. Thank you. Applied as 479e5f8. -- Father Chrysostomos |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#19333 (status was 'resolved')
Searchable as RT19333$
The text was updated successfully, but these errors were encountered: