src/src/exim_id_update.src

   1 #!PERL_COMMAND
   2 # Copyright (c) 2023 The Exim Maintainers
   3 # SPDX-License-Identifier: GPL-2.0-or-later
   4 # See the file NOTICE for conditions of use and distribution.
   5
   6 # Utility for one-time upgrage/downgrade between exim message-id formats,
   7 # around the 4.97 transition
   8
   9
  10 # This variables should be set by the building process
  11 my $spool = 'SPOOL_DIRECTORY';  # may be overridden later
  12
  13 use strict;
  14 use warnings;
  15 use Getopt::Std;
  16 use File::Find;
  17 use Fcntl;
  18 use File::FcntlLock;
  19 use IO::Handle;
  20
  21
  22 my %opt;
  23 my $mode_upgrade;
  24 my $id;
  25
  26 my $b62 = '[0-9A-Za-z]';
  27
  28 if (  !getopts('hud', \%opt)
  29    || $opt{h}
  30    || !$opt{u} && !$opt{d}
  31    ) {
  32   &help; exit 1;
  33 }
  34
  35 $spool = $ARGV[0] if ($ARGV[0]);
  36 $mode_upgrade = $opt{u};
  37
  38 sub help(){
  39   print <<'EOF'
  40 Utility for one-time down/upgrade of Exim message-id formats
  41 in spool files.  Only the filenames is first-line ID tag values
  42 are affected; not message content such as Message-ID fields.
  43 Only -H, -D and -J files are handled.
  44
  45 Syntax:  exim_id_update [-d | -u | -h] [spooldir]
  46
  47         -d      Downgrade mode
  48         -h      This help message
  49         -u      Upgrade mode
  50
  51 Exactly one of -d or -u must be given.
  52 The spool directory defaults to the build-time value,
  53 or can be given as a command-line argument.
  54 EOF
  55 }
  56
  57 # For downgrade mode:
  58 # - Check exim not running
  59 # - Wipe any wait-hints DBs, buy just removing the files.
  60 # For all queue (main and named), with split-spool if needed, for each file identifiable
  61 # as a spoolfile (name starts with an ID, ends with -H -D -J -K)
  62 #  XXX are there only subsets we can handle - eg. a -H + a -D ?
  63 #    mainline code sequence is -D (locks msg) -H ?-J
  64 #    mainline locking sequence (spool_open_datafile()) is
  65 #       - open -D
  66 #       - fnctl F_LOCK  (amount = first line of file)
  67
  68 # The -H and -D files contain the ID as their initial line.
  69 # The -J file
  70 # - records successful deliveries, as insurance vs. crashes
  71 # - has lines with mail addresses
  72 # The -K file
  73 # - is a temp for DKIM'd delivery when a transport-filter is in use
  74 # - contains the message that would have been put on the wire (except for encryption)
  75 #  - the transport, with tpt-filter, writes the file - and then reads it
  76 #    so as to generate the DKIM signature.  Then it sends the message, with
  77 #    generated headers and reading the file again, down the wire.
  78 #    And then it deletes it.
  79 # - unclear if we really want to rewrite these files, if we do see then
  80 #   Probably not.
  81
  82 # - if old-format name:
  83 #   - lock old message
  84 #   - generate new files, in safe sequence
  85 #   - remove old files  (do we need to archive?)
  86 #
  87
  88 # loop for default Q, named Qs
  89 #  loop for plain, split-spool
  90 #   loop over files
  91 #    if is -H, and -D exists
  92 #
  93 #     create new ID string from old
  94 #     lock the old -D
  95 #     create new -D
  96 #     lock new -D
  97 #     create new -H
  98 #
  99 #     if -J exists
 100 #      rename old -J to new -J
 101 #
 102 #     remove old -H
 103 #     remove old -D
 104 #     unlock new -D
 105 #
 106
 107 chdir $spool or die "failed cd to $spool";
 108 find( sub {
 109           do_file($_)
 110             if ($_ =~ ($mode_upgrade ? "${b62}{6}-${b62}{6}-${b62}{2}-D" : "${b62}{6}-${b62}{11}-${b62}{4}-D") );
 111           },
 112       '.' );
 113 exit 0;
 114
 115
 116 sub do_file {
 117   my $old_dfile = shift;
 118   my $old_prefix = $old_dfile;
 119   my ($old_hfile , $new_prefix);
 120   my ($d_old, $d_new);
 121   my $line;
 122
 123   $old_prefix =~ s/-D$//;
 124   $old_hfile = $old_prefix . '-H';
 125
 126   # The -H file must also exist
 127   return if (! -e $old_hfile);
 128
 129   $new_prefix = $old_prefix;
 130   if ($mode_upgrade) {
 131     $new_prefix =~ s/^([^-]*)-([^-]*)-(.*)$/$1-00000$2-${3}00/;
 132   } else {
 133     $new_prefix =~ s/^([^-]*)-.....([^-]*)-(..)..$/$1-$2-${3}/;
 134   }
 135
 136   ####### create the new -D file
 137
 138   open $d_old, '+<', $old_dfile
 139       or die "Can't open file: $!\n";
 140
 141   # lock the old -D file
 142   dfile_lock($d_old, $mode_upgrade ? 16 : 23);
 143   # seek past the first line
 144   <$d_old>;
 145
 146   # create the new -D file
 147   $d_new = f_create($new_prefix . '-D');
 148
 149   # lock the new -D file
 150   dfile_lock($d_new, $mode_upgrade ? 23 : 16);
 151
 152   # write the new message-id to the first line
 153   print $d_new "$new_prefix-D\n";
 154
 155   # copy the rest of the -D file
 156   while ($line = <$d_old>) {
 157     print $d_new $line;
 158   }
 159
 160   ####### create the new -H file
 161
 162   open my $h_old, '<', $old_hfile
 163       or die "Can't open file: $!\n";
 164   <$h_old>;
 165
 166   my $h_new = f_create($new_prefix . '-H');
 167   print $h_new "$new_prefix-H\n";
 168   while ($line = <$h_old>) {
 169     print $h_new $line;
 170   }
 171
 172   ###### rename a journal file if it exists
 173
 174   rename $old_prefix . '-J', $new_prefix . '-J' if (-e $old_prefix . '-J');
 175
 176   ###### tidy up
 177
 178   close $h_old;
 179   unlink $old_hfile or die "failed to remove $old_hfile";
 180   close $d_old;
 181   unlink $old_dfile or die "failed to remove $old_dfile";
 182
 183   dfile_unlock($d_new, $mode_upgrade ? 23 : 16);
 184   close $d_new;
 185 }
 186
 187
 188
 189 sub dfile_lock {
 190   my $fh = shift;
 191   my $nbytes = shift;
 192   my $fs = new File::FcntlLock;
 193
 194   $fs->l_type( F_WRLCK );
 195   $fs->l_whence( SEEK_CUR );
 196   $fs->l_start( 0 );
 197   $fs->l_len( $nbytes );
 198
 199   $fs->lock( $fh, F_SETLK )
 200       or die "Locking failed: " . $fs->error . "\n";
 201 }
 202
 203 sub dfile_unlock {
 204   my $fh = shift;
 205   my $nbytes = shift;
 206   my $fs = new File::FcntlLock;
 207
 208   $fs->l_type( F_UNLCK );
 209   $fs->l_whence( SEEK_CUR );
 210   $fs->l_start( 0 );
 211   $fs->l_len( $nbytes );
 212   $fs->lock( $fh, F_SETLK )
 213       or die "Unlocking failed: " . $fs->error . "\n";
 214 }
 215
 216 sub f_create {
 217   my $filename = shift;
 218   sysopen(my $fh, $filename, O_RDWR|O_CREAT|O_EXCL)
 219       or die "Can't create $filename: $!";
 220   $fh->autoflush(1);
 221   #
 222   # TODO: chown, chgrp exim; chmod 0640
 223   return $fh;
 224 }