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