76 # prototypes for other routines |
81 # prototypes for other routines |
77 sub parse_incoming($); |
82 sub parse_incoming($); |
78 sub uploader($); |
83 sub uploader($); |
79 sub run_command_and_parse_output($$$$$$); |
84 sub run_command_and_parse_output($$$$$$); |
80 sub parse_output($$$$$$$$); |
85 sub parse_output($$$$$$$$); |
81 sub sendmails($$$$); |
86 sub sendmails($$$$$); |
82 |
87 |
83 # anything matching these is considered noteworthy and should be sent to someone |
88 # anything matching these is considered noteworthy and should be sent to someone |
84 my $important = { |
89 my $important = { |
85 qq{^File "([^"]+)" is already registered with different checksums!} => \&m_mismatch, |
90 qq{^File "([^"]+)" is already registered with different checksums!} => \&m_mismatch, |
86 "^file '([^']+)' is needed for '([^']+)', not yet registered in the pool and not found in '([^']+)'\$" => \&m_missingfile, |
91 "^file '([^']+)' is needed for '([^']+)', not yet registered in the pool and not found in '([^']+)'\$" => \&m_missingfile, |
110 die "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n" unless defined $i; |
115 die "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n" unless defined $i; |
111 |
116 |
112 # we need to determine uploaders before running reprepro, because it will |
117 # we need to determine uploaders before running reprepro, because it will |
113 # remove the *.changes files before we are going to parse its output |
118 # remove the *.changes files before we are going to parse its output |
114 my $uploaders = { map { $_ => uploader($_) } glob("$i/*.changes") }; |
119 my $uploaders = { map { $_ => uploader($_) } glob("$i/*.changes") }; |
|
120 for my $c (keys %{$uploaders}) { sendmails ({ $uploaders->{$c} => scalar qx{lintian $c 2>&1} }, $valid_receivers, $fallback, $hostname, "[$hostname] Lintian Report"); } |
115 my $messages = run_command_and_parse_output([@cmd], $uploaders, $important, $unimportant, $log_uncaught, $log_raw); |
121 my $messages = run_command_and_parse_output([@cmd], $uploaders, $important, $unimportant, $log_uncaught, $log_raw); |
116 sendmails($messages, $valid_receivers, $fallback, $hostname); |
122 sendmails($messages, $valid_receivers, $fallback, $hostname, "[$hostname] Import Report"); |
117 |
123 |
118 # determine 'uploader' of changes file; 'uploader' means here: either the |
124 # determine 'uploader' of changes file; 'uploader' means here: either the |
119 # signer of the changes file or the changer or the maintainer in that order of |
125 # signer of the changes file or the changer or the maintainer in that order of |
120 # preference; the 'changer' means what is extracted from the 'Changed-By' field |
126 # preference; the 'changer' means what is extracted from the 'Changed-By' field |
121 # of the .changes file if present; 'maintainer' will be extracted from the |
127 # of the .changes file if present; 'maintainer' will be extracted from the |
326 return $m; |
332 return $m; |
327 |
333 |
328 } |
334 } |
329 |
335 |
330 # send the notification mails |
336 # send the notification mails |
331 sub sendmails($$$$) { |
337 sub sendmails($$$$$) { |
332 |
338 |
333 my ($messages, $valid_receivers, $fallback, $hostname) = @_; |
339 my ($messages, $valid_receivers, $fallback, $hostname, $subject) = @_; |
334 |
340 |
335 my $from = "$ENV{LOGNAME}\@$hostname"; |
341 my $from = "$ENV{LOGNAME}\@$hostname"; |
336 my $mfb = $messages->{'fallback'}; |
342 my $mfb = $messages->{'fallback'}; |
337 |
343 |
338 for my $u (keys %{$messages}) { |
344 for my $u (keys %{$messages}) { |
343 |
349 |
344 my ($msg, $to) = ($messages->{$u}, $u); |
350 my ($msg, $to) = ($messages->{$u}, $u); |
345 ($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; |
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; |
346 |
352 |
347 sendmail(From => $from, |
353 sendmail(From => $from, |
348 Subject => "[apt] Import Report", |
354 Subject => $subject, |
349 To => $to, |
355 To => $to, |
350 Message => $msg); |
356 Message => $msg); |
351 print "[$0]: ", $Mail::Sendmail::log, "\n"; |
357 print "[$0]: ", $Mail::Sendmail::log, "\n"; |
352 warn "[$0]: ", $Mail::Sendmail::error, "\n" if $Mail::Sendmail::error; |
358 warn "[$0]: ", $Mail::Sendmail::error, "\n" if $Mail::Sendmail::error; |
353 |
359 |
411 C<$unimportant> regular expression will not be sent to anyone. If we cant |
417 C<$unimportant> regular expression will not be sent to anyone. If we cant |
412 determine anyone to send the notification to we will try to send it to the |
418 determine anyone to send the notification to we will try to send it to the |
413 C<$fallback> address. Anything matching none of the defined patterns will be |
419 C<$fallback> address. Anything matching none of the defined patterns will be |
414 sent to the C<$fallback> address too. Everything will be printed to stdout. |
420 sent to the C<$fallback> address too. Everything will be printed to stdout. |
415 |
421 |
|
422 =head1 OPTIONS |
|
423 |
|
424 =over |
|
425 |
|
426 =item B<-l>|B<--[no]run-lintian> |
|
427 |
|
428 Do or don't run lintian on each changesfile an try to mail results to uploader. (default: do) |
|
429 |
|
430 =back |
|
431 |
416 =head1 AUTHORS |
432 =head1 AUTHORS |
417 |
433 |
418 Matthias Förste L<<foerste@schlittermann.de>> |
434 Matthias Förste L<<foerste@schlittermann.de>> |
419 |
435 |
420 =cut |
436 =cut |