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 a425ad03bdd982624b52c0989eb94d0288f314c7..acd56eee056dce9a188dee1dc43f568637366e9c 100644 (file)
--- 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<ame
 and updated by Heiko Schlittermann L<hs@schlittermann.de>.
 
 =cut
 and updated by Heiko Schlittermann L<hs@schlittermann.de>.
 
 =cut

+
+# vim:ft=perl:

diff --git a/src/src/exim_checkaccess.src b/src/src/exim_checkaccess.src
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/src/exim_id_update.src b/src/src/exim_id_update.src
index 8d4920e9c42c6fb02e67e5d8bffba424984ce918..b288edcb61e0be7ed98dcf28ce2ac0006a422f8c 100644 (file)
--- 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.
 # 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
 
 
 # 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 strict;
 use warnings;

-use Getopt::Std;
+use Fcntl qw(:DEFAULT :seek);
+use File::Basename;

 use File::Find;
 use File::Find;

-use Fcntl;
-use File::FcntlLock;
+use Getopt::Long;

 use IO::Handle;
 
 
 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.
 
 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
 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.
 # 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
 #
 #     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/^(?<prefix>($b62{6})-($b62{6})-($b62{2}))-D$/ : qr/^(?<prefix>($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 {
 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
 
   # write the new message-id to the first line

+  # and copy the rest of the -D file

   print $d_new "$new_prefix-D\n";
   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
 
   ####### 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>;
 
   <$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";
   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 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
 
   ###### 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;
   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";
 }
 
       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 {
 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: $!";
       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;
 }
   return $fh;
 }

+
+# vim:ft=perl:

diff --git a/src/src/exim_msgdate.src b/src/src/exim_msgdate.src
old mode 100755 (executable)
new mode 100644 (file)
index 4efee04..337f828
--- a/src/src/exim_msgdate.src
+++ b/src/src/exim_msgdate.src
@@ -626,3 +626,5 @@ L<exim(8)>
 L<Exim spec.txt chapter 4|https://exim.org/exim-html-current/doc/html/spec_html/ch-how_exim_receives_and_delivers_mail.html#SECTmessiden>
 
 =cut
 L<Exim spec.txt chapter 4|https://exim.org/exim-html-current/doc/html/spec_html/ch-how_exim_receives_and_delivers_mail.html#SECTmessiden>
 
 =cut

+
+# vim:ft=perl:

diff --git a/src/src/eximstats.src b/src/src/eximstats.src
index 232b3d13533b6d2549aca3daa121afbd4abdacc6..4776c85b742c71a7e2b79547d1f6b2a98bca4faf 100644 (file)
--- a/src/src/eximstats.src
+++ b/src/src/eximstats.src
@@ -4249,4 +4249,5 @@ if ($xls_fh) {
 }
 
 
 }
 
 

+# vim:ft=perl:

 # End of eximstats
 # End of eximstats

diff --git a/src/src/exipick.src b/src/src/exipick.src
index 991128c1db768d705fb14341a6cf42bd097872ed..c441936a2cd8f216a56985a74957c3318ae95316 100644 (file)
--- 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
 
 
 =cut
 

-# vim:ft=perl
+# vim:ft=perl:

diff --git a/src/src/exiqgrep.src b/src/src/exiqgrep.src
index 6a0d40b516552cb4d1c4633036d6e239def36362..81054a2a25fd638fff2a2d4ce0c1a22ad97c9780 100644 (file)
--- 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;
 }
        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 3918ab0b83ef77e2d7c45399846f652e406bb022..a2c34cc32a92285c25b41a11aa19a228f2c35205 100644 (file)
--- 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";
 
   $count, &print_volume_rounded($volume), $max_age, $min_age, "TOTAL");
 print "\n";
 

+# vim:ft=perl:

 # End
 # End

diff --git a/src/src/transport-filter.src b/src/src/transport-filter.src
index 1343f89d43c10b34173bdc13dd0dc6e1797aa861..25af594b8a3116e58bc32f326dcef5ab05c898a2 100644 (file)
--- a/src/src/transport-filter.src
+++ b/src/src/transport-filter.src
@@ -95,4 +95,5 @@ while (<STDIN>)
   printf(STDOUT "%s\n", $_);
   }
 
   printf(STDOUT "%s\n", $_);
   }
 

+# vim:ft=perl:

 # End
 # End