From: Heiko Schlittermann (HS12-RIPE) Date: Fri, 13 Sep 2024 20:48:20 +0000 (+0200) Subject: chg: delay loading of File::FcntlLock X-Git-Url: https://git.exim.org/exim.git/commitdiff_plain/2a2da1cfd5922e90ef0348483f815e23451d7747?hp=91c707ef9229d7ba5e17b885416761feb2fdfc46 chg: delay loading of File::FcntlLock chg: remove x-bit from *.src new: add ft=perl to all perl *src mark perl *.src as ft=perl chg: exim_id_update more perlish chg: delay the loading of File::FcntlLock chg: no need to unlock as we close the file add force option more perlish, add chown/chmod add: --verbose to exim_id_update --- diff --git a/src/src/exigrep.src b/src/src/exigrep.src index a425ad03b..acd56eee0 100644 --- a/src/src/exigrep.src +++ b/src/src/exigrep.src @@ -379,3 +379,5 @@ This manual page was stitched together from spec.txt by Andreas Metzler L. =cut + +# vim:ft=perl: diff --git a/src/src/exim_checkaccess.src b/src/src/exim_checkaccess.src old mode 100755 new mode 100644 diff --git a/src/src/exim_id_update.src b/src/src/exim_id_update.src index 8d4920e9c..b288edcb6 100644 --- a/src/src/exim_id_update.src +++ b/src/src/exim_id_update.src @@ -1,4 +1,4 @@ -#!PERL_COMMAND +#! PERL_COMMAND # Copyright (c) 2023 The Exim Maintainers # SPDX-License-Identifier: GPL-2.0-or-later # See the file NOTICE for conditions of use and distribution. @@ -7,60 +7,65 @@ # around the 4.97 transition -# This variables should be set by the building process -my $spool = 'SPOOL_DIRECTORY'; # may be overridden later - use strict; use warnings; -use Getopt::Std; +use Fcntl qw(:DEFAULT :seek); +use File::Basename; use File::Find; -use Fcntl; -use File::FcntlLock; +use Getopt::Long; use IO::Handle; -my %opt; -my $mode_upgrade; -my $id; - -my $b62 = '[0-9A-Za-z]'; - -if ( !getopts('hudv', \%opt) - || $opt{h} - || !$opt{v} && !$opt{u} && !$opt{d} - ) { - &help; exit 1; -} -if ($opt{v}) { - print "exim_id_update:\n", - "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n", - "perl(runtime): $]\n"; - exit 0; -} - -$spool = $ARGV[0] if ($ARGV[0]); -$mode_upgrade = $opt{u}; - -sub help(){ - print <<'EOF' +my $ME = basename($0); +my $help = <<"EOF"; Utility for one-time down/upgrade of Exim message-id formats in spool files. Only the filenames and first-line ID tag values are affected; not message content such as Message-ID fields. Only -H, -D and -J files are handled. -Syntax: exim_id_update [-d | -u | -h | -v] [spooldir] +Usage: $ME [-d | -u | -h | -v] [spooldir] - -d Downgrade mode - -h This help message - -u Upgrade mode - -v Version + -d --downgrade downgrade mode + -h --help help message + -u --upgrade upgrade mode + -v --version show version and exit cleanly + --verbose more output about what's going on + --force force overwriting (may be required after failure) + --dry dry run (do file operations, but cleanup and keep the old files) -Exactly one of -d or -u must be given. +Exactly one of -d|--downgrade or -u|--upgrade must be given. The spool directory defaults to the build-time value, or can be given as a command-line argument. EOF + +GetOptions(\my %opt, + 'help|h!', + 'version|v!', + 'upgrade|u!', + 'downgrade|d!', + 'force!', + 'verbose!', + 'dry!', +) or print STDERR $help and exit(1); + +if ($opt{version}) { + print "exim_id_update:\n", + "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n", + "perl(runtime): $]\n"; + exit 0; } +print $help and exit 0 if $opt{help}; + +# No help requested, do further option processing +my $spool = $ARGV[0] // 'SPOOL_DIRECTORY'; # This variable should be set by the building process + +die "$ME: --upgrade and --downgrade are mutually exclusive\n" if $opt{upgrade} && $opt{downgrade}; +die "$ME: one of --upgrade or --downgrade is required\n" if !$opt{upgrade} && !$opt{downgrade}; + +require File::FcntlLock; +File::FcntlLock->import; + # For downgrade mode: # - Check exim not running # - Wipe any wait-hints DBs, buy just removing the files. @@ -110,90 +115,91 @@ EOF # remove old -D # unlock new -D # - -chdir $spool or die "failed cd to $spool"; -find( sub { - do_file($_) - if ($_ =~ ($mode_upgrade ? "${b62}{6}-${b62}{6}-${b62}{2}-D" : "${b62}{6}-${b62}{11}-${b62}{4}-D") ); - }, - '.' ); +# +my $id; +my $pattern = do { + # setup the pattern, creating match groups already + my $b62 = qr/(?i:[\da-z])/; # one of the base62 characters + $opt{upgrade} ? qr/^(?($b62{6})-($b62{6})-($b62{2}))-D$/ : qr/^(?($b62{6})-$b62{5}($b62{6})-($b62{2})$b62{2})-D$/; +}; + +chdir $spool or die "chdir to $spool: $!\n"; +find( sub { do_file($_) if -f }, '.'); exit 0; sub do_file { - my $old_dfile = shift; - my $old_prefix = $old_dfile; - my ($old_hfile , $new_prefix); - my ($d_old, $d_new); - my $line; - - $old_prefix =~ s/-D$//; - $old_hfile = $old_prefix . '-H'; - - # The -H file must also exist - return if (! -e $old_hfile); - - $new_prefix = $old_prefix; - if ($mode_upgrade) { - $new_prefix =~ s/^([^-]*)-([^-]*)-(.*)$/$1-00000$2-${3}00/; - } else { - $new_prefix =~ s/^([^-]*)-.....([^-]*)-(..)..$/$1-$2-${3}/; - } + (my $old_dfile = shift) =~ /$pattern/ or return; - ####### create the new -D file + # $1…$4 are set by the regexp match + my $old_prefix = $+{prefix}; + my $new_prefix = $opt{upgrade} + ? "$2-00000$3-${4}00" + : "$2-$3-$4"; - open $d_old, '+<', $old_dfile - or die "Can't open file: $!\n"; + my $old_hfile = "$old_prefix-H"; - # lock the old -D file - dfile_lock($d_old, $mode_upgrade ? 16 : 23); - # seek past the first line - <$d_old>; + # The -H file must also exist, otherwise something is broken + return if not -e $old_hfile; + + my $old_jfile = "$old_prefix-J"; + my $new_dfile = "$new_prefix-D"; + my $new_hfile = "$new_prefix-H"; + my $new_jfile = "$new_prefix-J"; + + print "$old_prefix -> $new_prefix\n" if $opt{verbose}; - # create the new -D file - $d_new = f_create($new_prefix . '-D'); + ####### create the new -D file + open my $d_old, '+<', $old_dfile or die "Can't open file: $!\n"; + + # lock the old -D file and seek past the first line + lock_range($d_old, 2 + length($old_prefix)); # 2 for -D + <$d_old>; - # lock the new -D file - dfile_lock($d_new, $mode_upgrade ? 23 : 16); + # create and lock the new -D file + my $d_new = f_create($new_dfile, $old_dfile); + lock_range($d_new, 2 + length($new_prefix)); # 2 for -D # write the new message-id to the first line + # and copy the rest of the -D file print $d_new "$new_prefix-D\n"; - - # copy the rest of the -D file - while ($line = <$d_old>) { - print $d_new $line; - } + print $d_new $_ while <$d_old>; ####### create the new -H file - - open my $h_old, '<', $old_hfile - or die "Can't open file: $!\n"; + open my $h_old, '<', $old_hfile or die "Can't open file: $!\n"; <$h_old>; - my $h_new = f_create($new_prefix . '-H'); + my $h_new = f_create($new_hfile, $old_hfile); print $h_new "$new_prefix-H\n"; - while ($line = <$h_old>) { - print $h_new $line; + print $h_new $_ while <$h_old>; + + if ($opt{dry}) { + unlink $new_hfile, $new_dfile; # make sure they're removed, even if we die during close + close $h_new or die "close $new_hfile: $!\n"; + close $d_new or die "close $new_dfile: $!\n"; + return; # this will close the all file handles that are still open (and release their locks) } ###### rename a journal file if it exists - - rename $old_prefix . '-J', $new_prefix . '-J' if (-e $old_prefix . '-J'); + rename $old_jfile => $new_jfile + or $!{ENOENT} + or die "Can't rename $old_jfile to $new_jfile: $!\n"; ###### tidy up + # close the files we wrote, to be sure that there's nothing wrong + # the locks are released implicitly by closing the file handles. + close $h_new or die "$h_new: $!\n"; + close $d_new or die "$d_new: $!\n"; - close $h_old; - unlink $old_hfile or die "failed to remove $old_hfile"; - close $d_old; - unlink $old_dfile or die "failed to remove $old_dfile"; + unlink $old_hfile or die "failed to remove $old_hfile: $!\n"; + unlink $old_dfile or die "failed to remove $old_dfile: $!\n"; - dfile_unlock($d_new, $mode_upgrade ? 23 : 16); - close $d_new; + # no need to explicitly close the $d_old, $h_old, they're closed + # automatically when they go out of scope. And the locks are released + # by the OS after closing the files. } - - -sub dfile_lock { +sub lock_range { my $fh = shift; my $nbytes = shift; my $fs = new File::FcntlLock; @@ -207,25 +213,14 @@ sub dfile_lock { or die "Locking failed: " . $fs->error . "\n"; } -sub dfile_unlock { - my $fh = shift; - my $nbytes = shift; - my $fs = new File::FcntlLock; - - $fs->l_type( F_UNLCK ); - $fs->l_whence( SEEK_CUR ); - $fs->l_start( 0 ); - $fs->l_len( $nbytes ); - $fs->lock( $fh, F_SETLK ) - or die "Unlocking failed: " . $fs->error . "\n"; -} - sub f_create { - my $filename = shift; - sysopen(my $fh, $filename, O_RDWR|O_CREAT|O_EXCL) + my ($filename, $reference) = @_; + sysopen(my $fh, $filename, O_RDWR|O_CREAT| ($opt{force} ? 0 : O_EXCL)) or die "Can't create $filename: $!"; - $fh->autoflush(1); - # - # TODO: chown, chgrp exim; chmod 0640 + my ($perms, $uid, $gid) = (stat $reference)[2,4,5] or die "Can't stat reference $reference: $!\n"; + chown $uid, $gid => $fh or die "chown $filename: $!\n"; + chmod $perms & 07777 => $fh or die "chmod $filename: $!\n"; return $fh; } + +# vim:ft=perl: diff --git a/src/src/exim_msgdate.src b/src/src/exim_msgdate.src old mode 100755 new mode 100644 index 4efee04f8..337f828ce --- a/src/src/exim_msgdate.src +++ b/src/src/exim_msgdate.src @@ -626,3 +626,5 @@ L L =cut + +# vim:ft=perl: diff --git a/src/src/eximstats.src b/src/src/eximstats.src index 232b3d135..4776c85b7 100644 --- a/src/src/eximstats.src +++ b/src/src/eximstats.src @@ -4249,4 +4249,5 @@ if ($xls_fh) { } +# vim:ft=perl: # End of eximstats diff --git a/src/src/exipick.src b/src/src/exipick.src index 991128c1d..c441936a2 100644 --- a/src/src/exipick.src +++ b/src/src/exipick.src @@ -1841,4 +1841,4 @@ This script was incorporated into the main Exim distribution some years ago. =cut -# vim:ft=perl +# vim:ft=perl: diff --git a/src/src/exiqgrep.src b/src/src/exiqgrep.src index 6a0d40b51..81054a2a2 100644 --- a/src/src/exiqgrep.src +++ b/src/src/exiqgrep.src @@ -215,3 +215,5 @@ sub msg_utc() { while($#c >= 0) { $s = $s * $base + $tab62[ord(shift @c) - ord('0')] } return $s; } + +# vim:ft=perl: diff --git a/src/src/exiqsumm.src b/src/src/exiqsumm.src index 3918ab0b8..a2c34cc32 100644 --- a/src/src/exiqsumm.src +++ b/src/src/exiqsumm.src @@ -183,4 +183,5 @@ printf("%5d %.6s %6s %6s %.80s\n", $count, &print_volume_rounded($volume), $max_age, $min_age, "TOTAL"); print "\n"; +# vim:ft=perl: # End diff --git a/src/src/transport-filter.src b/src/src/transport-filter.src index 1343f89d4..25af594b8 100644 --- a/src/src/transport-filter.src +++ b/src/src/transport-filter.src @@ -95,4 +95,5 @@ while () printf(STDOUT "%s\n", $_); } +# vim:ft=perl: # End