34 } |
34 } |
35 ) or pod2usage; |
35 ) or pod2usage; |
36 |
36 |
37 my $hostname = hostname_long; |
37 my $hostname = hostname_long; |
38 for (*STDERR, *STDOUT) { select $_; $| = 1; } |
38 for (*STDERR, *STDOUT) { select $_; $| = 1; } |
|
39 |
|
40 my $rci = "$repo/conf/incoming"; |
|
41 my $i = parse_incoming($rci)->{$ruleset}->{'IncomingDir'}; |
|
42 die |
|
43 "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n" |
|
44 unless defined $i; |
|
45 my @changes = @ARGV or glob("$i/*.changes"); |
39 |
46 |
40 # see man reprepro |
47 # see man reprepro |
41 # used as argument to the -b option of reprepro |
48 # used as argument to the -b option of reprepro |
42 my $repo = "$ENV{HOME}/repo"; |
49 my $repo = "$ENV{HOME}/repo"; |
43 |
50 |
114 "(md5|sha(1|256)) expected: [[:xdigit:]]{32,}, got: [[:xdigit:]]{32,}", |
121 "(md5|sha(1|256)) expected: [[:xdigit:]]{32,}, got: [[:xdigit:]]{32,}", |
115 "size expected: \\d+, got: \\d+", |
122 "size expected: \\d+, got: \\d+", |
116 "There have been errors!" |
123 "There have been errors!" |
117 ) . '$'; |
124 ) . '$'; |
118 |
125 |
119 my $rci = "$repo/conf/incoming"; |
|
120 my $i = parse_incoming($rci)->{$ruleset}->{'IncomingDir'}; |
|
121 die |
|
122 "Can't find IncomingDir for ruleset [$ruleset] in configuration file: [$rci]\n" |
|
123 unless defined $i; |
|
124 |
|
125 # we need to determine uploaders before running reprepro, because it will |
126 # we need to determine uploaders before running reprepro, because it will |
126 # remove the *.changes files before we are going to parse its output |
127 # remove the *.changes files before we are going to parse its output |
127 my $uploaders = { map { $_ => uploader($_) } glob("$i/*.changes") }; |
128 my $uploaders = { map { $_ => uploader($_) } @changes }; |
128 if ($opt{'run-lintian'}) { |
129 if ($opt{'run-lintian'}) { |
129 for my $c (keys %{$uploaders}) { |
130 for my $c (keys %{$uploaders}) { |
130 sendmails({ $uploaders->{$c} => scalar qx{lintian $c 2>&1} }, |
131 sendmails({ $uploaders->{$c} => scalar qx{lintian $c 2>&1} }, |
131 $valid_receivers, $fallback, $hostname, |
132 $valid_receivers, $fallback, $hostname, |
132 "[$hostname] Lintian Report"); |
133 "[$hostname] Lintian Report"); |
133 } |
134 my $messages = |
134 } |
135 run_command_and_parse_output([@cmd, $c], $uploaders, $important, $unimportant, |
135 my $messages = |
136 $log_uncaught, $log_raw); |
136 run_command_and_parse_output([@cmd], $uploaders, $important, $unimportant, |
137 sendmails($messages, $valid_receivers, $fallback, $hostname, |
137 $log_uncaught, $log_raw); |
138 "[$hostname] Import Report"); |
138 sendmails($messages, $valid_receivers, $fallback, $hostname, |
139 |
139 "[$hostname] Import Report"); |
140 } |
140 |
141 } |
141 # determine 'uploader' of changes file; 'uploader' means here: either the |
142 # determine 'uploader' of changes file; 'uploader' means here: either the |
142 # signer of the changes file or the changer or the maintainer in that order of |
143 # signer of the changes file or the changer or the maintainer in that order of |
143 # preference; the 'changer' means what is extracted from the 'Changed-By' field |
144 # preference; the 'changer' means what is extracted from the 'Changed-By' field |
144 # of the .changes file if present; 'maintainer' will be extracted from the |
145 # of the .changes file if present; 'maintainer' will be extracted from the |
145 # 'Maintainer' field if necessary; nothing will be returned if the signature |
146 # 'Maintainer' field if necessary; nothing will be returned if the signature |