bin/rpi
branchrsync
changeset 35 ff9bdf95363c
parent 34 da128a0b985f
child 37 a31ece02f311
equal deleted inserted replaced
34:da128a0b985f 35:ff9bdf95363c
    12 use Getopt::Long;
    12 use Getopt::Long;
    13 use Mail::Sendmail;
    13 use Mail::Sendmail;
    14 use Pod::Usage;
    14 use Pod::Usage;
    15 use Sys::Hostname::Long;
    15 use Sys::Hostname::Long;
    16 
    16 
    17 my %opt = (
    17 my %opt = ('run-lintian' => 1,);
    18     'run-lintian' => 1,
       
    19 );
       
    20 
    18 
    21 GetOptions(
    19 GetOptions(
    22     "l|run-lintian!"     => \$opt{'run-lintian'},
    20     "l|run-lintian!" => \$opt{'run-lintian'},
    23     "h|help"            => sub { pod2usage(-exit => 0, -verbose => 1) },
    21     "h|help"         => sub { pod2usage(-exit => 0, -verbose => 1) },
    24     "m|man"             => sub {
    22     "m|man"          => sub {
    25         pod2usage(
    23         pod2usage(
    26             -exit    => 0,
    24             -exit    => 0,
    27             -verbose => 2,
    25             -verbose => 2,
    28 
    26 
    29             # "system('perldoc -V &>/dev/null')" appears shorter, but may not
    27             # "system('perldoc -V &>/dev/null')" appears shorter, but may not
    33         );
    31         );
    34     }
    32     }
    35 ) or pod2usage;
    33 ) or pod2usage;
    36 
    34 
    37 my $hostname = hostname_long;
    35 my $hostname = hostname_long;
    38 for (*STDERR, *STDOUT) { select $_; $|=1; }
    36 for (*STDERR, *STDOUT) { select $_; $| = 1; }
    39 
    37 
    40 # see man reprepro
    38 # see man reprepro
    41 # used as argument to the -b option of reprepro
    39 # used as argument to the -b option of reprepro
    42 my $repo = "$ENV{HOME}/repo";
    40 my $repo = "$ENV{HOME}/repo";
    43 
    41 
    85 sub parse_output($$$$$$$$);
    83 sub parse_output($$$$$$$$);
    86 sub sendmails($$$$$);
    84 sub sendmails($$$$$);
    87 
    85 
    88 # anything matching these is considered noteworthy and should be sent to someone
    86 # anything matching these is considered noteworthy and should be sent to someone
    89 my $important = {
    87 my $important = {
    90   qq{^File "([^"]+)" is already registered with different checksums!} => \&m_mismatch,
    88     qq{^File "([^"]+)" is already registered with different checksums!} =>
    91   "^file '([^']+)' is needed for '([^']+)', not yet registered in the pool and not found in '([^']+)'\$" => \&m_missingfile,
    89       \&m_mismatch,
    92   "^Warning: trying to put version '([^']+)' of '([^']+)' in '([^']+)',\$" => \&m_mayexist,
    90     "^file '([^']+)' is needed for '([^']+)', not yet registered in the pool and not found in '([^']+)'\$"
    93   "^Skipping ([^ ]+) because all packages are skipped!\$" => \&m_allskipped,
    91       => \&m_missingfile,
    94   "^Data seems not to be signed trying to use directly...\$" => \&m_unsigned,
    92     "^Warning: trying to put version '([^']+)' of '([^']+)' in '([^']+)',\$" =>
    95   "^Not putting '([^']+)' in '([^']+)' as already in there with equal or newer version.\$" => \&m_equal_or_newer,
    93       \&m_mayexist,
    96 #  "^ERROR: File '([^']+)' does not match expextations:\$" => \&m_asis,
    94     "^Skipping ([^ ]+) because all packages are skipped!\$" => \&m_allskipped,
    97 #  "^In 'littlebird_2011072500-2_amd64.changes': file 'littlebird_2011072500.orig.tar.gz' not found in the incoming dir!" => \&m_asis,
    95     "^Data seems not to be signed trying to use directly...\$" => \&m_unsigned,
    98 # send *everything* for now
    96     "^Not putting '([^']+)' in '([^']+)' as already in there with equal or newer version.\$"
    99   "." => \&m_asis
    97       => \&m_equal_or_newer,
       
    98 
       
    99     #  "^ERROR: File '([^']+)' does not match expextations:\$" => \&m_asis,
       
   100     #  "^In 'littlebird_2011072500-2_amd64.changes': file 'littlebird_2011072500.orig.tar.gz' not found in the incoming dir!" => \&m_asis,
       
   101     # send *everything* for now
       
   102     "." => \&m_asis
   100 };
   103 };
   101 
   104 
   102 # anything matching these will not be sent to anyone
   105 # anything matching these will not be sent to anyone
   103 my $unimportant = '^'
   106 my $unimportant = '^'
   104   . ( join '|',
   107   . (
       
   108     join '|',
   105     "Deleting files no longer referenced...",
   109     "Deleting files no longer referenced...",
   106     "Exporting indices...",
   110     "Exporting indices...",
   107     "while there already is '[^']+' in there.",
   111     "while there already is '[^']+' in there.",
   108     "(md5|sha(1|256)) expected: [[:xdigit:]]{32,}, got: [[:xdigit:]]{32,}",
   112     "(md5|sha(1|256)) expected: [[:xdigit:]]{32,}, got: [[:xdigit:]]{32,}",
   109     "size expected: \\d+, got: \\d+",
   113     "size expected: \\d+, got: \\d+",
   110     "There have been errors!")
   114     "There have been errors!"
   111   . '$';
   115   ) . '$';
   112 
   116 
   113 my $rci = "$repo/conf/incoming";
   117 my $rci = "$repo/conf/incoming";
   114 my $i = parse_incoming($rci)->{$ruleset}->{'IncomingDir'};
   118 my $i   = parse_incoming($rci)->{$ruleset}->{'IncomingDir'};
   115 die "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n" unless defined $i;
   119 die
       
   120   "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n"
       
   121   unless defined $i;
   116 
   122 
   117 # we need to determine uploaders before running reprepro, because it will
   123 # we need to determine uploaders before running reprepro, because it will
   118 # remove the *.changes files before we are going to parse its output
   124 # remove the *.changes files before we are going to parse its output
   119 my $uploaders = { map { $_ => uploader($_) } glob("$i/*.changes") };
   125 my $uploaders = { map { $_ => uploader($_) } glob("$i/*.changes") };
   120 if ($opt{'run-lintian'}) { for my $c (keys %{$uploaders}) { sendmails ({ $uploaders->{$c} => scalar qx{lintian $c 2>&1} }, $valid_receivers, $fallback, $hostname, "[$hostname] Lintian Report"); }};
   126 if ($opt{'run-lintian'}) {
   121 my $messages = run_command_and_parse_output([@cmd], $uploaders, $important, $unimportant, $log_uncaught, $log_raw);
   127     for my $c (keys %{$uploaders}) {
   122 sendmails($messages, $valid_receivers, $fallback, $hostname, "[$hostname] Import Report");
   128         sendmails({ $uploaders->{$c} => scalar qx{lintian $c 2>&1} },
       
   129             $valid_receivers, $fallback, $hostname,
       
   130             "[$hostname] Lintian Report");
       
   131     }
       
   132 }
       
   133 my $messages =
       
   134   run_command_and_parse_output([@cmd], $uploaders, $important, $unimportant,
       
   135     $log_uncaught, $log_raw);
       
   136 sendmails($messages, $valid_receivers, $fallback, $hostname,
       
   137     "[$hostname] Import Report");
   123 
   138 
   124 # determine 'uploader' of changes file; 'uploader' means here: either the
   139 # determine 'uploader' of changes file; 'uploader' means here: either the
   125 # signer of the changes file or the changer or the maintainer in that order of
   140 # signer of the changes file or the changer or the maintainer in that order of
   126 # preference; the 'changer' means what is extracted from the 'Changed-By' field
   141 # preference; the 'changer' means what is extracted from the 'Changed-By' field
   127 # of the .changes file if present; 'maintainer' will be extracted from the
   142 # of the .changes file if present; 'maintainer' will be extracted from the
   128 # 'Maintainer' field if necessary; nothing will be returned if the signature
   143 # 'Maintainer' field if necessary; nothing will be returned if the signature
   129 # verification command fails for some reason
   144 # verification command fails for some reason
   130 sub uploader($) {
   145 sub uploader($) {
   131   my ($c) = @_;
   146     my ($c) = @_;
   132   my $vc = "LANG=POSIX /usr/bin/gpg --verify $c 2>&1";
   147     my $vc = "LANG=POSIX /usr/bin/gpg --verify $c 2>&1";
   133 
   148 
   134   my @r = qx{$vc};
   149     my @r = qx{$vc};
   135 
   150 
   136   if ($?) {
   151     if ($?) {
   137     warn "[$0]: [$vc] failed: [$!] [$?]\n";
   152         warn "[$0]: [$vc] failed: [$!] [$?]\n";
   138     return;
   153         return;
   139   }
   154     }
   140 
   155 
   141   for (@r) {
   156     for (@r) {
   142     return "$1" if /^gpg: Good signature from "(.+)"$/;
   157         return "$1" if /^gpg: Good signature from "(.+)"$/;
   143   }
   158     }
   144 
   159 
   145   my $e;
   160     my $e;
   146   my $fh = new IO::File "< $c" or warn "[$0]: Can't open [< $c]: $!\n";
   161     my $fh = new IO::File "< $c" or warn "[$0]: Can't open [< $c]: $!\n";
   147   while (<$fh>) {
   162     while (<$fh>) {
   148     if (/^Changed-By:\s*(\S.+\S)\s*$/) {
   163         if (/^Changed-By:\s*(\S.+\S)\s*$/) {
   149       $e = $1; last;
   164             $e = $1;
   150     }
   165             last;
   151     $e = $1 if /^Maintainer:\s*(\S.+\S)\s*$/
   166         }
   152   }
   167         $e = $1 if /^Maintainer:\s*(\S.+\S)\s*$/;
   153   close $fh or warn "[$0]: Can't close [$fh]: $!\n";
   168     }
   154 
   169     close $fh or warn "[$0]: Can't close [$fh]: $!\n";
   155   return $e;
   170 
       
   171     return $e;
   156 
   172 
   157 }
   173 }
   158 
   174 
   159 # checksum mismatch
   175 # checksum mismatch
   160 sub m_mismatch($) {
   176 sub m_mismatch($) {
   161   return "Try to remove the offending lines from the changesfile or just rebuild with dpkg-buildpackage -B\n";
   177     return
       
   178       "Try to remove the offending lines from the changesfile or just rebuild with dpkg-buildpackage -B\n";
   162 }
   179 }
   163 
   180 
   164 # missingfile
   181 # missingfile
   165 sub m_missingfile($$$) {
   182 sub m_missingfile($$$) {
   166   my ($m, $i, $c) = @_;
   183     my ($m, $i, $c) = @_;
   167   my $t = $m =~ /\.orig\.tar\.gz$/ ? "Try to rebuild with dpkg-buildpackage -sa or do 'changestool <.changes-filename> includeallsources' and resign the changesfile afterwards\n" : '';
   184     my $t =
   168   #print "MISSINGFILE: [$c], [$t]\n";
   185       $m =~ /\.orig\.tar\.gz$/
   169   return $t;
   186       ? "Try to rebuild with dpkg-buildpackage -sa or do 'changestool <.changes-filename> includeallsources' and resign the changesfile afterwards\n"
       
   187       : '';
       
   188 
       
   189     #print "MISSINGFILE: [$c], [$t]\n";
       
   190     return $t;
   170 }
   191 }
   171 
   192 
   172 # mayexist
   193 # mayexist
   173 sub m_mayexist($$$) {
   194 sub m_mayexist($$$) {
   174   # package & version are confused in reprepro output
   195 
   175   # currently (3.5.2-6)
   196     # package & version are confused in reprepro output
   176   # my ($p, $v, $cca) = @_;
   197     # currently (3.5.2-6)
   177   # $cca =~ /^[^|]+\|[^|]+\|([^|]+)$/;
   198     # my ($p, $v, $cca) = @_;
   178 
   199     # $cca =~ /^[^|]+\|[^|]+\|([^|]+)$/;
   179   #print "MAYEXIST: [$c], [package ..]\n";
   200 
   180   return "package may be already present with higher version\n";
   201     #print "MAYEXIST: [$c], [package ..]\n";
       
   202     return "package may be already present with higher version\n";
   181 }
   203 }
   182 
   204 
   183 # allskipped
   205 # allskipped
   184 sub m_allskipped($) {
   206 sub m_allskipped($) {
   185   #print "ALLSKIPPED: [$_[0]], [nüx ..]\n";
   207 
   186   return "package may be already present with same or higher version\n";
   208     #print "ALLSKIPPED: [$_[0]], [nüx ..]\n";
       
   209     return "package may be already present with same or higher version\n";
   187 }
   210 }
   188 
   211 
   189 # equal or newer
   212 # equal or newer
   190 sub m_equal_or_newer($$) {
   213 sub m_equal_or_newer($$) {
   191   #print "EQUAL_OR_NEWER: [$_[0]], [nüx ..]\n";
   214 
   192   return '';
   215     #print "EQUAL_OR_NEWER: [$_[0]], [nüx ..]\n";
       
   216     return '';
   193 }
   217 }
   194 
   218 
   195 # unsigned
   219 # unsigned
   196 sub m_unsigned($) { return 'You may want to check whether both the .changes and the .dsc file are signed'; }
   220 sub m_unsigned($) {
       
   221     return
       
   222       'You may want to check whether both the .changes and the .dsc file are signed';
       
   223 }
   197 
   224 
   198 # return empty string
   225 # return empty string
   199 sub m_asis() { return ''; }
   226 sub m_asis() { return ''; }
   200 
   227 
   201 # parse conf/incoming, return ref to hash:
   228 # parse conf/incoming, return ref to hash:
   202 # { name1 => { field11 => value11, field12 => value12, ... },
   229 # { name1 => { field11 => value11, field12 => value12, ... },
   203 # { name2 => { field21 => value21, ... }, ...
   230 # { name2 => { field21 => value21, ... }, ...
   204 sub parse_incoming($) {
   231 sub parse_incoming($) {
   205 
   232 
   206   my ($cf) = @_;
   233     my ($cf) = @_;
   207   my ($name, $conf);
   234     my ($name, $conf);
   208   my $fh = new IO::File "< $cf" or warn "Can't open [< $cf]: $!";
   235     my $fh = new IO::File "< $cf" or warn "Can't open [< $cf]: $!";
   209 
   236 
   210   while (<$fh>) { 
   237     while (<$fh>) {
   211 
   238 
   212     if (/^(\S+)\s*:\s*(\S+)\s/) {
   239         if (/^(\S+)\s*:\s*(\S+)\s/) {
   213 
   240 
   214       if ($1 eq 'Name') {
   241             if ($1 eq 'Name') {
   215 	$name = $2;
   242                 $name = $2;
   216 	$conf->{$name} = {};
   243                 $conf->{$name} = {};
   217       } else {
   244             } else {
   218 	warn "Undefined Name\n" unless defined $name;
   245                 warn "Undefined Name\n" unless defined $name;
   219 	$conf->{$name}->{$1} = $2;
   246                 $conf->{$name}->{$1} = $2;
   220       }
   247             }
   221 
   248 
   222     }
   249         }
   223 
   250 
   224   }
   251     }
   225   close $fh or warn "Can't close [$fh]: $!\n";
   252     close $fh or warn "Can't close [$fh]: $!\n";
   226 
   253 
   227   return $conf;
   254     return $conf;
   228 
   255 
   229 }
   256 }
   230 
   257 
   231 # run the command and parse its output
   258 # run the command and parse its output
   232 sub run_command_and_parse_output($$$$$$) {
   259 sub run_command_and_parse_output($$$$$$) {
   233 
   260 
   234   my @cmd = @{shift()};
   261     my @cmd = @{ shift() };
   235   my ($u, $important, $unimportant, $luname, $lrname) = @_;
   262     my ($u, $important, $unimportant, $luname, $lrname) = @_;
   236 
   263 
   237   my ($ih, $oh, $eh);
   264     my ($ih, $oh, $eh);
   238 
   265 
   239   run \@cmd, \$ih, \$oh, \$eh or warn "running [@cmd] returned: [$?] [$!]\n";
   266     run \@cmd, \$ih, \$oh, \$eh or warn "running [@cmd] returned: [$?] [$!]\n";
   240 
   267 
   241   my ($ln, $lh);
   268     my ($ln, $lh);
   242   $ln = { uncaught => $luname, raw => $lrname };
   269     $ln = { uncaught => $luname, raw => $lrname };
   243 
   270 
   244   for (keys %{$ln}) {
   271     for (keys %{$ln}) {
   245     if (defined $ln->{$_}) {
   272         if (defined $ln->{$_}) {
   246       $lh->{$_} = new IO::File $ln->{$_} or warn "Can't open [$ln->{$_}]: $!\n";
   273             $lh->{$_} = new IO::File $ln->{$_}
   247     }
   274               or warn "Can't open [$ln->{$_}]: $!\n";
   248   }
   275         }
   249 
   276     }
   250   my $messages = parse_output([@cmd], $oh, $eh, $u, $important, $unimportant, $lh->{'uncaught'}, $lh->{'raw'});
   277 
   251   
   278     my $messages =
   252   for (keys %{$lh}) {
   279       parse_output([@cmd], $oh, $eh, $u, $important, $unimportant,
   253     if (defined $lh->{$_}) {
   280         $lh->{'uncaught'}, $lh->{'raw'});
   254       close $lh->{$_} or warn "Can't close [$lh->{$_}]: $!";
   281 
   255     }
   282     for (keys %{$lh}) {
   256   }
   283         if (defined $lh->{$_}) {
   257 
   284             close $lh->{$_} or warn "Can't close [$lh->{$_}]: $!";
   258   return $messages;
   285         }
       
   286     }
       
   287 
       
   288     return $messages;
   259 
   289 
   260 }
   290 }
   261 
   291 
   262 # parse the commands output extract messages matching the defined patterns from
   292 # parse the commands output extract messages matching the defined patterns from
   263 # stdout/err, add suggestions for problem resolution if possible and try to
   293 # stdout/err, add suggestions for problem resolution if possible and try to
   264 # assign it to an uploader
   294 # assign it to an uploader
   265 sub parse_output($$$$$$$$) {
   295 sub parse_output($$$$$$$$) {
   266 
   296 
   267   my @cmd = @{shift()};
   297     my @cmd = @{ shift() };
   268   my ($oh, $eh, $u, $important, $unimportant, $uncaught, $raw) = @_;
   298     my ($oh, $eh, $u, $important, $unimportant, $uncaught, $raw) = @_;
   269 
   299 
   270   my ($m, $c, $f);
   300     my ($m, $c, $f);
   271 
   301 
   272   $f = 'fallback';
   302     $f = 'fallback';
   273 
   303 
   274   LINE:
   304   LINE:
   275   for my $line (split /\n/, $oh . $eh) {
   305     for my $line (split /\n/, $oh . $eh) {
   276 
   306 
   277     $line .= "\n";
   307         $line .= "\n";
   278     print "[@cmd]: $line";
   308         print "[@cmd]: $line";
   279     print $raw "[" . gmtime() . " +0000] $line" if defined $raw;
   309         print $raw "[" . gmtime() . " +0000] $line" if defined $raw;
   280 
   310 
   281     # try to determine uploader
   311         # try to determine uploader
   282     if ($line =~ /^processing changesfile '([^']+)'$/) {
   312         if ($line =~ /^processing changesfile '([^']+)'$/) {
   283       $c = $1;
   313             $c = $1;
   284       $u = $uploaders->{$c};
   314             $u = $uploaders->{$c};
   285       unless (defined $u) {
   315             unless (defined $u) {
   286 
   316 
   287 	$u = $f;
   317                 $u = $f;
   288 	my $w = "Won't send notification for [$i/$c] because i couldn't determine any uploader to sent it to.\n"; 
   318                 my $w =
   289 	$m->{$u} //= '';
   319                   "Won't send notification for [$i/$c] because i couldn't determine any uploader to sent it to.\n";
   290 	$m->{$u} .= "[$c]: $w";
   320                 $m->{$u} //= '';
   291 	warn "[$0]: $w";
   321                 $m->{$u} .= "[$c]: $w";
   292 
   322                 warn "[$0]: $w";
   293       }
   323 
   294 
   324             }
   295       next LINE;
   325 
   296 
   326             next LINE;
   297     }
   327 
   298 
   328         }
   299     # done with that changesfile
   329 
   300     if ($line =~ /^changesfile '[^']+' done$/) { 
   330         # done with that changesfile
   301       undef $c;
   331         if ($line =~ /^changesfile '[^']+' done$/) {
   302       $u = $f;
   332             undef $c;
   303       next LINE;
   333             $u = $f;
   304     }
   334             next LINE;
   305 
   335         }
   306     # anything matching $important should be sent to someone
   336 
   307     for (keys(%{$important})) {
   337         # anything matching $important should be sent to someone
   308       if ($line =~ $_) {
   338         for (keys(%{$important})) {
   309 	my $t = $important->{$_}->($1, $2, $3, $4, $5, $6, $7, $8, $9);
   339             if ($line =~ $_) {
   310 	if (defined $u) {
   340                 my $t = $important->{$_}->($1, $2, $3, $4, $5, $6, $7, $8, $9);
   311 	  $m->{$u} = '' unless defined $m->{$u};
   341                 if (defined $u) {
   312 	  $m->{$u} .= "[" . ( defined $c ? $c : "no changesfile" ) . "]: $line";
   342                     $m->{$u} = '' unless defined $m->{$u};
   313 	  $m->{$u} .= $t if defined $t;
   343                     $m->{$u} .=
   314 	  $m->{$u} .= "\n";
   344                       "[" . (defined $c ? $c : "no changesfile") . "]: $line";
   315 	}
   345                     $m->{$u} .= $t if defined $t;
   316 	next LINE;
   346                     $m->{$u} .= "\n";
   317       }
   347                 }
   318 
   348                 next LINE;
   319     }
   349             }
   320 
   350 
   321     # unimportant stuff?
   351         }
   322     next LINE if $line =~ /$unimportant/;
   352 
   323 
   353         # unimportant stuff?
   324     # everything not matching any other pattern
   354         next LINE if $line =~ /$unimportant/;
   325     $m->{$f} = '' unless defined $m->{$f};
   355 
   326     $m->{$f} .= "[uncaught line]: $line\n";
   356         # everything not matching any other pattern
   327 
   357         $m->{$f} = '' unless defined $m->{$f};
   328     print $uncaught "[" . gmtime() . " +0000] $line" if defined $uncaught;
   358         $m->{$f} .= "[uncaught line]: $line\n";
   329 
   359 
   330   }
   360         print $uncaught "[" . gmtime() . " +0000] $line" if defined $uncaught;
   331 
   361 
   332   return $m;
   362     }
       
   363 
       
   364     return $m;
   333 
   365 
   334 }
   366 }
   335 
   367 
   336 # send the notification mails
   368 # send the notification mails
   337 sub sendmails($$$$$) {
   369 sub sendmails($$$$$) {
   338 
   370 
   339   my ($messages, $valid_receivers, $fallback, $hostname, $subject) = @_;
   371     my ($messages, $valid_receivers, $fallback, $hostname, $subject) = @_;
   340 
   372 
   341   my $from = "$ENV{LOGNAME}\@$hostname";
   373     my $from = "$ENV{LOGNAME}\@$hostname";
   342   my $mfb = $messages->{'fallback'};
   374     my $mfb  = $messages->{'fallback'};
   343 
   375 
   344   for my $u (keys %{$messages}) {
   376     for my $u (keys %{$messages}) {
   345 
   377 
   346     next if $u eq 'fallback';
   378         next if $u eq 'fallback';
   347 
   379 
   348     if ($u =~ $valid_receivers) {
   380         if ($u =~ $valid_receivers) {
   349 
   381 
   350       my ($msg, $to) = ($messages->{$u}, $u);
   382             my ($msg, $to) = ($messages->{$u}, $u);
   351       ($msg, $to) = ("[This is just a test mail to you. If this wasn't a test mail, then it should have been sent to [$u]]\n\n" . $messages->{$u}, $fallback) if $dont_send_to_real_uploader;
   383             ($msg, $to) = (
   352 
   384                 "[This is just a test mail to you. If this wasn't a test mail, then it should have been sent to [$u]]\n\n"
   353       sendmail(From => $from,
   385                   . $messages->{$u},
   354 	Subject => $subject,
   386                 $fallback
   355 	To => $to,
   387             ) if $dont_send_to_real_uploader;
   356 	Message => $msg);
   388 
   357       print "[$0]: ", $Mail::Sendmail::log, "\n";
   389             sendmail(
   358       warn "[$0]: ", $Mail::Sendmail::error, "\n" if $Mail::Sendmail::error;
   390                 From    => $from,
   359 
   391                 Subject => $subject,
   360     } else {
   392                 To      => $to,
   361 
   393                 Message => $msg
   362       my $w = "Won't send notification: invalid receiver [$u]\n\n";
   394             );
   363       $mfb //= ''; $mfb .= $w; $mfb .= ">>>\n[$messages->{$u}]\n<<<\n\n";
   395             print "[$0]: ", $Mail::Sendmail::log, "\n";
   364       warn "[$0]: $w";
   396             warn "[$0]: ", $Mail::Sendmail::error, "\n"
   365 
   397               if $Mail::Sendmail::error;
   366     }
   398 
   367 
   399         } else {
   368   }
   400 
   369 
   401             my $w = "Won't send notification: invalid receiver [$u]\n\n";
   370   if (defined $mfb) {
   402             $mfb //= '';
   371 
   403             $mfb .= $w;
   372     sendmail(From => $from,
   404             $mfb .= ">>>\n[$messages->{$u}]\n<<<\n\n";
   373       Subject => "[apt] Possible Problem processing incoming",
   405             warn "[$0]: $w";
   374       To => $fallback,
   406 
   375       Message => $mfb);
   407         }
   376     print "[$0]: ", $Mail::Sendmail::log, "\n";
   408 
   377     warn "[$0]: ", $Mail::Sendmail::error, "\n" if $Mail::Sendmail::error;
   409     }
   378 
   410 
   379   }
   411     if (defined $mfb) {
       
   412 
       
   413         sendmail(
       
   414             From    => $from,
       
   415             Subject => "[apt] Possible Problem processing incoming",
       
   416             To      => $fallback,
       
   417             Message => $mfb
       
   418         );
       
   419         print "[$0]: ", $Mail::Sendmail::log, "\n";
       
   420         warn "[$0]: ", $Mail::Sendmail::error, "\n" if $Mail::Sendmail::error;
       
   421 
       
   422     }
   380 
   423 
   381 }
   424 }
   382 
   425 
   383 sub BEGIN {
   426 sub BEGIN {
   384   print "[$0]: Started at ", scalar localtime, "\n";
   427     print "[$0]: Started at ", scalar localtime, "\n";
   385 }
   428 }
   386 
   429 
   387 sub END {
   430 sub END {
   388   print "[$0]: Finished at ", scalar localtime, "\n";
   431     print "[$0]: Finished at ", scalar localtime, "\n";
   389 }
   432 }
   390 
   433 
   391 __END__
   434 __END__
   392 
   435 
   393 =head1 NAME
   436 =head1 NAME