Rev 1 | Rev 6 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 1 | Rev 5 | ||
---|---|---|---|
1 | #! /usr/bin/perl -w |
1 | #! /usr/bin/perl -w |
2 | 2 | ||
3 | ##### |
3 | ##### |
4 | # |
4 | # |
5 | # Copyright 2003-2004 Joel Baker. All rights reserved. |
5 | # Copyright 2003-2004 Joel Baker. All rights reserved. |
6 | # |
6 | # |
7 | # Redistribution and use in source and binary forms, with or without |
7 | # Redistribution and use in source and binary forms, with or without |
8 | # modification, are permitted provided that the following conditions |
8 | # modification, are permitted provided that the following conditions |
9 | # are met: |
9 | # are met: |
10 | # 1. Redistributions of source code must retain the above copyright |
10 | # 1. Redistributions of source code must retain the above copyright |
11 | # notice, this list of conditions and the following disclaimer. |
11 | # notice, this list of conditions and the following disclaimer. |
12 | # 2. Redistributions in binary form must reproduce the above copyright |
12 | # 2. Redistributions in binary form must reproduce the above copyright |
13 | # notice, this list of conditions and the following disclaimer in the |
13 | # notice, this list of conditions and the following disclaimer in the |
14 | # documentation and/or other materials provided with the distribution. |
14 | # documentation and/or other materials provided with the distribution. |
15 | # 3. Neither the name of the Author nor the names of any contributors |
15 | # 3. Neither the name of the Author nor the names of any contributors |
16 | # may be used to endorse or promote products derived from this software |
16 | # may be used to endorse or promote products derived from this software |
17 | # without specific prior written permission. |
17 | # without specific prior written permission. |
18 | # |
18 | # |
19 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
19 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
20 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
20 | # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
21 | # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
21 | # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
22 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
22 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
23 | # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
23 | # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
24 | # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
24 | # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
25 | # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
25 | # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
26 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
26 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
27 | # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
27 | # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
28 | # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
28 | # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
29 | # SUCH DAMAGE. |
29 | # SUCH DAMAGE. |
30 | # |
30 | # |
31 | # $Id: debpool 54 2005-02-21 21:48:29Z joel $ |
31 | # $Id: debpool 54 2005-02-21 21:48:29Z joel $ |
32 | # |
32 | # |
33 | ##### |
33 | ##### |
34 | 34 | ||
35 | # Put our private support module area into the search path |
35 | # Put our private support module area into the search path |
36 | 36 | ||
37 | use lib '/usr/share/debpool/perl5'; |
37 | use lib '/usr/share/debpool/perl5'; |
38 | 38 | ||
39 | # We always want to be careful about things... |
39 | # We always want to be careful about things... |
40 | 40 | ||
41 | use strict; |
41 | use strict; |
42 | use warnings; |
42 | use warnings; |
43 | 43 | ||
44 | use POSIX; # This gets us strftime. |
44 | use POSIX; # This gets us strftime. |
45 | 45 | ||
46 | # First things first - figure out how we need to be configured. |
46 | # First things first - figure out how we need to be configured. |
47 | 47 | ||
48 | use Getopt::Long qw(:config pass_through); |
48 | use Getopt::Long qw(:config pass_through); |
49 | use DebPool::Config qw(:functions :vars); |
49 | use DebPool::Config qw(:functions :vars); |
50 | 50 | ||
51 | # First, grab --config and --nodefault options if they exist. We |
51 | # First, grab --config and --nodefault options if they exist. We |
52 | # don't want these in the %Options hash, and they affect what we do when |
52 | # don't want these in the %Options hash, and they affect what we do when |
53 | # loading it. |
53 | # loading it. |
54 | 54 | ||
55 | my(@config_files); |
55 | my(@config_files); |
56 | my($default); |
56 | my($default); |
57 | 57 | ||
58 | GetOptions('config=s' => \@config_files, 'default!' => \$default); |
58 | GetOptions('config=s' => \@config_files, 'default!' => \$default); |
59 | 59 | ||
60 | # Call Load_Default_Configs if we're loading default values, or |
60 | # Call Load_Default_Configs if we're loading default values, or |
61 | # Load_Minimal_Configs if we're not (we still need the OptionDefs hash to |
61 | # Load_Minimal_Configs if we're not (we still need the OptionDefs hash to |
62 | # be populated). |
62 | # be populated). |
63 | 63 | ||
64 | if (!defined($default) || $default) { |
64 | if (!defined($default) || $default) { |
65 | Load_Default_Configs(); |
65 | Load_Default_Configs(); |
66 | } else { |
66 | } else { |
67 | Load_Minimal_Configs(); |
67 | Load_Minimal_Configs(); |
68 | } |
68 | } |
69 | 69 | ||
70 | # Load any config files we were given. |
70 | # Load any config files we were given. |
71 | 71 | ||
72 | my($config); |
72 | my($config); |
73 | 73 | ||
74 | foreach $config (@config_files) { |
74 | foreach $config (@config_files) { |
75 | Load_File_Configs($config); |
75 | Load_File_Configs($config); |
76 | } |
76 | } |
77 | 77 | ||
78 | # And finally, pull in any other command line options. |
78 | # And finally, pull in any other command line options. |
79 | 79 | ||
80 | GetOptions(\%Options, values(%OptionDefs)); |
80 | GetOptions(\%Options, values(%OptionDefs)); |
81 | 81 | ||
82 | # Run the cleanup stuff on %Options. |
82 | # Run the cleanup stuff on %Options. |
83 | 83 | ||
84 | Clean_Options(); |
84 | Clean_Options(); |
85 | 85 | ||
86 | # Okay. We're more or less ready to go. First, load some modules that we |
86 | # Okay. We're more or less ready to go. First, load some modules that we |
87 | # know we'll be calling. |
87 | # know we'll be calling. |
88 | 88 | ||
89 | use DebPool::Dirs qw(:functions :vars); # Directory management |
89 | use DebPool::Dirs qw(:functions :vars); # Directory management |
90 | use DebPool::DB qw(:functions :vars); # Various databases |
90 | use DebPool::DB qw(:functions :vars); # Various databases |
91 | use DebPool::GnuPG qw(:functions :vars); # GnuPG interaction routines |
91 | use DebPool::GnuPG qw(:functions :vars); # GnuPG interaction routines |
92 | use DebPool::Gzip qw(:functions :vars); # Gzip interaction routines |
92 | use DebPool::Gzip qw(:functions :vars); # Gzip interaction routines |
93 | use DebPool::Logging qw(:functions :facility :level); # Logging routines |
93 | use DebPool::Logging qw(:functions :facility :level); # Logging routines |
94 | use DebPool::Packages qw(:functions :vars); # Distribution databases |
94 | use DebPool::Packages qw(:functions :vars); # Distribution databases |
95 | use DebPool::Signal qw(:functions :vars); # Handle signals |
95 | use DebPool::Signal qw(:functions :vars); # Handle signals |
96 | 96 | ||
97 | # Before we do anything else, let's find out if we need to act as a daemon, |
97 | # Before we do anything else, let's find out if we need to act as a daemon, |
98 | # and if so, whether we can manage to pull it off. |
98 | # and if so, whether we can manage to pull it off. |
99 | 99 | ||
100 | if ($Options{'daemon'}) { |
100 | if ($Options{'daemon'}) { |
101 | Log_Message("Trying to enter daemon mode.", LOG_GENERAL, LOG_DEBUG); |
101 | Log_Message("Trying to enter daemon mode.", LOG_GENERAL, LOG_DEBUG); |
102 | 102 | ||
103 | require Proc::Daemon; |
103 | require Proc::Daemon; |
104 | Proc::Daemon::Init(); |
104 | Proc::Daemon::Init(); |
105 | 105 | ||
106 | Log_Message("Now running as a daemon.", LOG_GENERAL, LOG_DEBUG); |
106 | Log_Message("Now running as a daemon.", LOG_GENERAL, LOG_DEBUG); |
107 | } |
107 | } |
108 | 108 | ||
109 | # Create the directory tree. This is clean even it it already exists, |
109 | # Create the directory tree. This is clean even it it already exists, |
110 | # so we can do it every time we start up. I believe the fancy word is |
110 | # so we can do it every time we start up. I believe the fancy word is |
111 | # 'idempotent'. We do this before grabbing a lockfile because it should |
111 | # 'idempotent'. We do this before grabbing a lockfile because it should |
112 | # never screw anything up, even if run multiple times at once, and our |
112 | # never screw anything up, even if run multiple times at once, and our |
113 | # lockfile may be (probably is, in fact) in one of these places. |
113 | # lockfile may be (probably is, in fact) in one of these places. |
114 | 114 | ||
115 | if (!Create_Tree()) { |
115 | if (!Create_Tree()) { |
116 | my($msg) = "Couldn't create directory tree: $DebPool::Dirs::Error"; |
116 | my($msg) = "Couldn't create directory tree: $DebPool::Dirs::Error"; |
117 | Log_Message($msg, LOG_GENERAL, LOG_FATAL); |
117 | Log_Message($msg, LOG_GENERAL, LOG_FATAL); |
118 | die "$msg\n"; |
118 | die "$msg\n"; |
119 | } |
119 | } |
120 | 120 | ||
121 | # Obtain a lockfile. We should never run more than one occurance; it's too |
121 | # Obtain a lockfile. We should never run more than one occurance; it's too |
122 | # likely that we'd step on our own toes. |
122 | # likely that we'd step on our own toes. |
123 | 123 | ||
124 | if (!sysopen(LOCK_FILE, $Options{'lock_file'}, O_WRONLY|O_CREAT|O_EXCL, 0644)) { |
124 | if (!sysopen(LOCK_FILE, $Options{'lock_file'}, O_WRONLY|O_CREAT|O_EXCL, 0644)) { |
125 | my($msg) = "Couldn't obtain lockfile '$Options{'lock_file'}'; "; |
125 | my($msg) = "Couldn't obtain lockfile '$Options{'lock_file'}'; "; |
126 | 126 | ||
127 | if (open(LOCK_FILE, '<', $Options{'lock_file'}) && |
127 | if (open(LOCK_FILE, '<', $Options{'lock_file'}) && |
128 | (my($pid) = <LOCK_FILE>)) { |
128 | (my($pid) = <LOCK_FILE>)) { |
129 | chomp($pid); |
129 | chomp($pid); |
130 | $msg .= "(PID $pid)\n"; |
130 | $msg .= "(PID $pid)\n"; |
131 | } else { |
131 | } else { |
132 | $msg .= "(unable to read PID)\n"; |
132 | $msg .= "(unable to read PID)\n"; |
133 | } |
133 | } |
134 | 134 | ||
135 | die $msg; |
135 | die $msg; |
136 | } else { # Do something useful - like put our PID into the file. |
136 | } else { # Do something useful - like put our PID into the file. |
137 | print LOCK_FILE "$$\n"; |
137 | print LOCK_FILE "$$\n"; |
138 | close(LOCK_FILE); |
138 | close(LOCK_FILE); |
139 | } |
139 | } |
140 | 140 | ||
141 | # Start the main loop. We use a do/until loop so that we always fire off at |
141 | # Start the main loop. We use a do/until loop so that we always fire off at |
142 | # least once. |
142 | # least once. |
143 | 143 | ||
144 | MAIN_LOOP: do { |
144 | MAIN_LOOP: do { |
145 | 145 | ||
146 | Log_Message("Starting processing run", LOG_GENERAL, LOG_DEBUG); |
146 | Log_Message("Starting processing run", LOG_GENERAL, LOG_DEBUG); |
147 | 147 | ||
148 | # First off, open up our databases. We do this each time through the loop, |
148 | # First off, open up our databases. We do this each time through the loop, |
149 | # so that they get flushed periodically if we're in daemon mode. |
149 | # so that they get flushed periodically if we're in daemon mode. |
150 | 150 | ||
151 | Open_Databases(); |
151 | Open_Databases(); |
152 | 152 | ||
153 | # This keeps track of what distributions need to have their Packages and |
153 | # This keeps track of what distributions need to have their Packages and |
154 | # Sources files rebuilt. We force it to be 'everything' if the user has |
154 | # Sources files rebuilt. We force it to be 'everything' if the user has |
155 | # requested a rebuild (normally from the command line). |
155 | # requested a rebuild (normally from the command line). |
156 | 156 | ||
157 | my(%rebuild) = (); |
157 | my(%rebuild) = (); |
158 | 158 | ||
159 | if ($Options{'rebuild-files'}) { |
159 | if ($Options{'rebuild-files'}) { |
160 | my($dist); |
160 | my($dist); |
161 | foreach $dist (@{$Options{'realdists'}}) { |
161 | foreach $dist (@{$Options{'realdists'}}) { |
162 | $rebuild{$dist} = 1; |
162 | $rebuild{$dist} = 1; |
163 | } |
163 | } |
164 | } |
164 | } |
165 | 165 | ||
166 | # Check for any changes files in the incoming directory. |
166 | # Check for any changes files in the incoming directory. |
167 | 167 | ||
168 | my(@changefiles) = Scan_Changes($Options{'incoming_dir'}); |
168 | my(@changefiles) = Scan_Changes($Options{'incoming_dir'}); |
169 | 169 | ||
170 | # Go through each of the changes files we found, and process it. This is the |
170 | # Go through each of the changes files we found, and process it. This is the |
171 | # heart of things. |
171 | # heart of things. |
172 | 172 | ||
173 | my($changefile); |
173 | my($changefile); |
174 | 174 | ||
175 | foreach $changefile (@changefiles) { |
175 | foreach $changefile (@changefiles) { |
176 | Log_Message("Processing changefile '$changefile'", LOG_GENERAL, LOG_INFO); |
176 | Log_Message("Processing changefile '$changefile'", LOG_GENERAL, LOG_INFO); |
177 | 177 | ||
178 | # .dsc = .changes, minus the part after the last _, plus .dsc |
178 | # .dsc = .changes, minus the part after the last _, plus .dsc |
179 | 179 | ||
180 | my(@parts) = split(/_/, $changefile); |
180 | my(@parts) = split(/_/, $changefile); |
181 | pop(@parts); |
181 | pop(@parts); |
182 | my($dscfile) = join('_', @parts) . '.dsc'; |
182 | my($dscfile) = join('_', @parts) . '.dsc'; |
183 | 183 | ||
184 | my($changes_data) = Parse_Changes("$Options{'incoming_dir'}/$changefile"); |
184 | my($changes_data) = Parse_Changes("$Options{'incoming_dir'}/$changefile"); |
185 | if (!defined($changes_data)) { |
185 | if (!defined($changes_data)) { |
186 | Log_Message("Failure parsing changes file '$changefile': " . |
186 | Log_Message("Failure parsing changes file '$changefile': " . |
187 | $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
187 | $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
188 | next; |
188 | next; |
189 | } |
189 | } |
190 | 190 | ||
191 | my($with_source) = undef; # Upload with or without source? |
191 | my($with_source) = undef; # Upload with or without source? |
192 | my($temp); |
192 | my($temp); |
193 | 193 | ||
194 | for $temp (@{$changes_data->{'Architecture'}}) { |
194 | for $temp (@{$changes_data->{'Architecture'}}) { |
195 | if ('source' eq $temp) { |
195 | if ('source' eq $temp) { |
196 | $with_source = 1; |
196 | $with_source = 1; |
197 | } |
197 | } |
198 | } |
198 | } |
199 | 199 | ||
200 | my($has_orig) = undef; # Has an orig tarball? |
200 | my($has_orig) = undef; # Has an orig tarball? |
201 | my($filehr); |
201 | my($filehr); |
202 | 202 | ||
203 | foreach $filehr (@{$changes_data->{'Files'}}) { |
203 | foreach $filehr (@{$changes_data->{'Files'}}) { |
204 | if ($filehr->{'Filename'} =~ /orig\.tar\.gz/) { |
204 | if ($filehr->{'Filename'} =~ /orig\.tar\.gz/) { |
205 | $has_orig = 1; |
205 | $has_orig = 1; |
206 | } |
206 | } |
207 | } |
207 | } |
208 | 208 | ||
209 | my($dsc_data) = Parse_DSC("$Options{'incoming_dir'}/$dscfile"); |
209 | my($dsc_data) = Parse_DSC("$Options{'incoming_dir'}/$dscfile"); |
210 | if ($with_source && !defined($dsc_data)) { |
210 | if ($with_source && !defined($dsc_data)) { |
211 | Log_Message("Failure parsing dsc file '$dscfile': " . |
211 | Log_Message("Failure parsing dsc file '$dscfile': " . |
212 | $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
212 | $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
213 | next; |
213 | next; |
214 | } |
214 | } |
215 | 215 | ||
216 | my($package) = $changes_data->{'Source'}; |
216 | my($package) = $changes_data->{'Source'}; |
217 | my($version) = $changes_data->{'Version'}; |
217 | my($version) = $changes_data->{'Version'}; |
218 | 218 | ||
219 | if ($Options{'require_sigs'}) { |
219 | if ($Options{'require_sigs'}) { |
220 | # First, check the changefile signature |
220 | # First, check the changefile signature |
221 | 221 | ||
222 | if (!Check_Signature("$Options{'incoming_dir'}/$changefile")) { |
222 | if (!Check_Signature("$Options{'incoming_dir'}/$changefile")) { |
223 | Reject_Package($changefile, $changes_data); |
223 | Reject_Package($changefile, $changes_data); |
224 | Log_Message("GPG signature failure in changes file '$changefile'", |
224 | Log_Message("GPG signature failure in changes file '$changefile'", |
225 | LOG_REJECT, LOG_ERROR); |
225 | LOG_REJECT, LOG_ERROR); |
226 | next; |
226 | next; |
227 | } else { |
227 | } else { |
228 | Log_Message("Successful changes signature: '$changefile'", |
228 | Log_Message("Successful changes signature: '$changefile'", |
229 | LOG_GPG, LOG_DEBUG); |
229 | LOG_GPG, LOG_DEBUG); |
230 | } |
230 | } |
231 | 231 | ||
232 | # Now check the dscfile signature |
232 | # Now check the dscfile signature |
233 | 233 | ||
234 | if ($with_source && !Check_Signature("$Options{'incoming_dir'}/$dscfile")) { |
234 | if ($with_source && !Check_Signature("$Options{'incoming_dir'}/$dscfile")) { |
235 | Reject_Package($changefile, $changes_data); |
235 | Reject_Package($changefile, $changes_data); |
236 | Log_Message("GPG signature failure in dsc file '$dscfile'", |
236 | Log_Message("GPG signature failure in dsc file '$dscfile'", |
237 | LOG_REJECT, LOG_ERROR); |
237 | LOG_REJECT, LOG_ERROR); |
238 | next; |
238 | next; |
239 | } else { |
239 | } else { |
240 | Log_Message("Successful dsc signature: '$dscfile'", |
240 | Log_Message("Successful dsc signature: '$dscfile'", |
241 | LOG_GPG, LOG_DEBUG); |
241 | LOG_GPG, LOG_DEBUG); |
242 | } |
242 | } |
243 | } |
243 | } |
244 | 244 | ||
245 | # Verify MD5 checksums on all files. |
245 | # Verify MD5 checksums on all files. |
246 | 246 | ||
247 | my($valid) = 1; |
247 | my($valid) = 1; |
248 | 248 | ||
249 | foreach $filehr (@{$changes_data->{'Files'}}) { |
249 | foreach $filehr (@{$changes_data->{'Files'}}) { |
250 | if (!(Verify_MD5("$Options{'incoming_dir'}/$filehr->{'Filename'}", |
250 | if (!(Verify_MD5("$Options{'incoming_dir'}/$filehr->{'Filename'}", |
251 | $filehr->{'MD5Sum'}))) { |
251 | $filehr->{'MD5Sum'}))) { |
252 | $valid = undef; |
252 | $valid = undef; |
253 | } |
253 | } |
254 | } |
254 | } |
255 | 255 | ||
256 | if (!$valid) { |
256 | if (!$valid) { |
257 | Reject_Package($changefile, $changes_data); |
257 | Reject_Package($changefile, $changes_data); |
258 | 258 | ||
259 | my($msg) = "MD5 checksum failure in changes file '$changefile'"; |
259 | my($msg) = "MD5 checksum failure in changes file '$changefile'"; |
260 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
260 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
261 | next; |
261 | next; |
262 | } |
262 | } |
263 | 263 | ||
264 | $valid = 1; |
264 | $valid = 1; |
265 | my($rejected) = undef; |
265 | my($rejected) = undef; |
266 | 266 | ||
267 | if ($with_source) { |
267 | if ($with_source) { |
268 | foreach $filehr (@{$dsc_data->{'Files'}}) { |
268 | foreach $filehr (@{$dsc_data->{'Files'}}) { |
269 | # A bit of a special case here; if the Changes file lists an |
269 | # A bit of a special case here; if the Changes file lists an |
270 | # orig tarball, we must *not* have one for that version in the |
270 | # orig tarball, we must *not* have one for that version in the |
271 | # pool. If it doesn't, then we *must* have one. In either case, |
271 | # pool. If it doesn't, then we *must* have one. In either case, |
272 | # as long as it's in the right place we use that file for the |
272 | # as long as it's in the right place we use that file for the |
273 | # MD5Sum check when the file is listed in the DSC. |
273 | # MD5Sum check when the file is listed in the DSC. |
274 | 274 | ||
275 | my($file) = $filehr->{'Filename'}; |
275 | my($file) = $filehr->{'Filename'}; |
276 | 276 | ||
277 | if ($file =~ /orig\.tar\.gz/) { |
277 | if ($file =~ /orig\.tar\.gz/) { |
278 | my($section) = Guess_Section($changes_data); |
278 | my($section) = Guess_Section($changes_data); |
279 | my($pkg_pooldir) = join('/', |
279 | my($pkg_pooldir) = join('/', |
280 | ($Options{'pool_dir'}, PoolDir($package, $section), |
280 | ($Options{'pool_dir'}, PoolDir($package, $section), |
281 | $package)); |
281 | $package)); |
282 | 282 | ||
283 | if ($has_orig) { # Orig tarball uploaded |
283 | if ($has_orig) { # Orig tarball uploaded |
284 | if (-e "$pkg_pooldir/$file") { |
284 | if (-e "$pkg_pooldir/$file") { |
285 | Reject_Package($changefile, $changes_data); |
285 | Reject_Package($changefile, $changes_data); |
286 | 286 | ||
287 | my($msg) = "Duplicate orig tarball '$file'"; |
287 | my($msg) = "Duplicate orig tarball '$file'"; |
288 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
288 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
289 | 289 | ||
290 | $rejected = 1; |
290 | $rejected = 1; |
291 | last; # Don't check other files, we just rejected |
291 | last; # Don't check other files, we just rejected |
292 | } elsif (!(-e "$Options{'incoming_dir'}/$file")) { |
292 | } elsif (!(-e "$Options{'incoming_dir'}/$file")) { |
293 | Reject_Package($changefile, $changes_data); |
293 | Reject_Package($changefile, $changes_data); |
294 | 294 | ||
295 | my($msg) = "Missing orig tarball '$file'"; |
295 | my($msg) = "Missing orig tarball '$file'"; |
296 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
296 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
297 | 297 | ||
298 | $rejected = 1; |
298 | $rejected = 1; |
299 | last; # Don't check other files, we just rejected |
299 | last; # Don't check other files, we just rejected |
300 | } else { |
300 | } else { |
301 | $file = "$Options{'incoming_dir'}/$file"; |
301 | $file = "$Options{'incoming_dir'}/$file"; |
302 | } |
302 | } |
303 | } else { # Orig tarball in pool - we hope |
303 | } else { # Orig tarball in pool - we hope |
304 | if (!(-e "$pkg_pooldir/$file")) { |
304 | if (!(-e "$pkg_pooldir/$file")) { |
305 | Reject_Package($changefile, $changes_data); |
305 | Reject_Package($changefile, $changes_data); |
306 | 306 | ||
307 | my($msg) = "Missing orig tarball '$file'"; |
307 | my($msg) = "Missing orig tarball '$file'"; |
308 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
308 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
309 | 309 | ||
310 | $rejected = 1; |
310 | $rejected = 1; |
311 | last; # Don't check other files, we just rejected |
311 | last; # Don't check other files, we just rejected |
312 | } else { |
312 | } else { |
313 | $file = "$pkg_pooldir/$file"; |
313 | $file = "$pkg_pooldir/$file"; |
314 | } |
314 | } |
315 | } |
315 | } |
316 | } else { # Not an orig tarball - must be in upload |
316 | } else { # Not an orig tarball - must be in upload |
317 | $file = "$Options{'incoming_dir'}/$file"; |
317 | $file = "$Options{'incoming_dir'}/$file"; |
318 | } |
318 | } |
319 | 319 | ||
320 | # Whatever it is, it must also pass the MD5 checksum test. |
320 | # Whatever it is, it must also pass the MD5 checksum test. |
321 | 321 | ||
322 | if (!(Verify_MD5($file, $filehr->{'MD5Sum'}))) { |
322 | if (!(Verify_MD5($file, $filehr->{'MD5Sum'}))) { |
323 | $valid = undef; |
323 | $valid = undef; |
324 | last; # Don't check other files, we already failed |
324 | last; # Don't check other files, we already failed |
325 | } |
325 | } |
326 | } |
326 | } |
327 | } |
327 | } |
328 | 328 | ||
329 | next if ($rejected); # Reject message already logged, go to next package. |
329 | next if ($rejected); # Reject message already logged, go to next package. |
330 | 330 | ||
331 | if (!$valid) { |
331 | if (!$valid) { |
332 | Reject_Package($changefile, $changes_data); |
332 | Reject_Package($changefile, $changes_data); |
333 | 333 | ||
334 | my($msg) = "MD5 checksum failure in dsc file '$dscfile'"; |
334 | my($msg) = "MD5 checksum failure in dsc file '$dscfile'"; |
335 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
335 | Log_Message($msg, LOG_REJECT, LOG_ERROR); |
336 | next; |
336 | next; |
337 | } |
337 | } |
338 | 338 | ||
339 | # Go through each distribution in the changes file, and decide whether |
339 | # Go through each distribution in the changes file, and decide whether |
340 | # the package is valid for that distribution. |
340 | # the package is valid for that distribution. |
341 | 341 | ||
342 | my($distribution, $realdist); |
342 | my($distribution, $realdist); |
343 | my(@valid_dists); |
343 | my(@valid_dists); |
344 | 344 | ||
345 | foreach $distribution (@{$changes_data->{'Distribution'}}) { |
345 | foreach $distribution (@{$changes_data->{'Distribution'}}) { |
346 | $realdist = $distribution; |
346 | $realdist = $distribution; |
347 | 347 | ||
348 | if (defined($Options{'virtual_dists'}->{$realdist})) { |
348 | if (defined($Options{'virtual_dists'}->{$realdist})) { |
349 | $realdist = $Options{'virtual_dists'}->{$realdist}; |
349 | $realdist = $Options{'virtual_dists'}->{$realdist}; |
350 | } |
350 | } |
351 | 351 | ||
352 | if (defined($Options{'dists'}->{$realdist})) { |
352 | if (defined($Options{'dists'}->{$realdist})) { |
353 | $realdist = $Options{'dists'}->{$realdist}; |
353 | $realdist = $Options{'dists'}->{$realdist}; |
354 | } |
354 | } |
355 | 355 | ||
356 | if (!defined($realdist)) { |
356 | if (!defined($realdist)) { |
357 | Log_Message("Distribution $distribution does not exist", |
357 | Log_Message("Distribution $distribution does not exist", |
358 | LOG_INSTALL, LOG_ERROR); |
358 | LOG_INSTALL, LOG_ERROR); |
359 | next; |
359 | next; |
360 | } |
360 | } |
361 | 361 | ||
362 | my($allow) = Allow_Version($package, $version, $realdist); |
362 | my($allow) = Allow_Version($package, $version, $realdist); |
363 | 363 | ||
364 | if (!defined($allow)) { |
364 | if (!defined($allow)) { |
365 | Log_Message("Version check for $version failed: " . |
365 | Log_Message("Version check for $version failed: " . |
366 | $DebPool::Packages::Error, LOG_INSTALL, LOG_ERROR); |
366 | $DebPool::Packages::Error, LOG_INSTALL, LOG_ERROR); |
367 | next; |
367 | next; |
368 | } |
368 | } |
369 | 369 | ||
370 | if (!$allow) { |
370 | if (!$allow) { |
371 | Log_Message("Cannot install version $version of $package to " . |
371 | Log_Message("Cannot install version $version of $package to " . |
372 | "$realdist", LOG_INSTALL, LOG_WARNING); |
372 | "$realdist", LOG_INSTALL, LOG_WARNING); |
373 | next; |
373 | next; |
374 | } |
374 | } |
375 | 375 | ||
376 | # It's valid. Put it in the list. |
376 | # It's valid. Put it in the list. |
377 | 377 | ||
378 | push(@valid_dists, $realdist); |
378 | push(@valid_dists, $realdist); |
379 | } |
379 | } |
380 | 380 | ||
381 | if (-1 == $#valid_dists) { |
381 | if (-1 == $#valid_dists) { |
382 | Reject_Package($changefile, $changes_data); |
382 | Reject_Package($changefile, $changes_data); |
383 | Log_Message("No valid distributions for version $version of $package", |
383 | Log_Message("No valid distributions for version $version of $package", |
384 | LOG_REJECT, LOG_ERROR); |
384 | LOG_REJECT, LOG_ERROR); |
385 | next; |
385 | next; |
386 | } |
386 | } |
387 | 387 | ||
388 | # Install the package |
388 | # Install the package |
389 | 389 | ||
390 | if (Install_Package($changefile, $changes_data, $dscfile, $dsc_data, \@valid_dists)) { |
390 | if (Install_Package($changefile, $changes_data, $dscfile, $dsc_data, \@valid_dists)) { |
391 | my($dist); |
391 | my($dist); |
392 | foreach $dist (@valid_dists) { |
392 | foreach $dist (@valid_dists) { |
393 | $rebuild{$dist} = 1; |
393 | $rebuild{$dist} = 1; |
394 | } |
394 | } |
395 | 395 | ||
396 | my($msg) = "Installed $package ($version) to "; |
396 | my($msg) = "Installed $package ($version) to "; |
397 | $msg .= "distribution(s): " . join(', ', @valid_dists); |
397 | $msg .= "distribution(s): " . join(', ', @valid_dists); |
398 | Log_Message($msg, LOG_INSTALL, LOG_INFO); |
398 | Log_Message($msg, LOG_INSTALL, LOG_INFO); |
399 | } else { |
399 | } else { |
400 | # Something is very, very wrong. |
400 | # Something is very, very wrong. |
401 | Log_Message("Couldn't install package '$package': " . |
401 | Log_Message("Couldn't install package '$package': " . |
402 | $DebPool::Packages::Error, LOG_INSTALL, LOG_FATAL); |
402 | $DebPool::Packages::Error, LOG_INSTALL, LOG_FATAL); |
403 | Close_Databases(); |
403 | Close_Databases(); |
404 | unlink($Options{'lock_file'}); # Release our lock |
404 | unlink($Options{'lock_file'}); # Release our lock |
405 | die "Couldn't install package '$package'\n"; |
405 | die "Couldn't install package '$package'\n"; |
406 | } |
406 | } |
407 | 407 | ||
408 | # And, now that that's done, audit the package area in the pool to get |
408 | # And, now that that's done, audit the package area in the pool to get |
409 | # rid of crufty, obsolete versions. |
409 | # rid of crufty, obsolete versions. |
410 | 410 | ||
411 | Audit_Package($package, $changes_data); |
411 | Audit_Package($package, $changes_data); |
412 | } |
412 | } |
413 | 413 | ||
414 | # Regenerate {Packages,Sources}{,.gz} for distributions which need it. Also |
414 | # Regenerate {Packages,Sources}{,.gz} for distributions which need it. Also |
415 | # rebuild Release files that need it, if we're doing them. |
415 | # rebuild Release files that need it, if we're doing them. |
416 | 416 | ||
417 | my($dist, $section); |
417 | my($dist, $section); |
418 | 418 | ||
419 | foreach $dist (keys(%rebuild)) { |
419 | foreach $dist (keys(%rebuild)) { |
420 | my(@rel_filelist) = (); |
420 | my(@rel_filelist) = (); |
421 | foreach $section (@{$Options{'sections'}}) { |
421 | foreach $section (@{$Options{'sections'}}) { |
422 | my(@archs) = @{$Options{'archs'}}; |
422 | my(@archs) = @{$Options{'archs'}}; |
423 | @archs = grep(!/^all$/, @archs); # We don't build binary-all files. |
423 | @archs = grep(!/^all$/, @archs); # We don't build binary-all files. |
424 | 424 | ||
425 | my($arch); |
425 | my($arch); |
426 | 426 | ||
427 | ARCH_LOOP: |
427 | ARCH_LOOP: |
428 | foreach $arch (@{$Options{'archs'}}) { |
428 | foreach $arch (@{$Options{'archs'}}) { |
429 | # We cheat, and use @triple for dist/section/arch inputs. |
429 | # We cheat, and use @triple for dist/section/arch inputs. |
430 | # Perl lets us get away with this. I'd care, except that Perl |
430 | # Perl lets us get away with this. I'd care, except that Perl |
431 | # prototyping isn't, so it's useless to not do this. |
431 | # prototyping isn't, so it's useless to not do this. |
432 | 432 | ||
433 | my(@triple) = ($dist, $section, $arch); |
433 | my(@triple) = ($dist, $section, $arch); |
434 | 434 | ||
435 | # Generate a Packages/Sources file. |
435 | # Generate a Packages/Sources file. |
436 | 436 | ||
437 | my($file) = Generate_List(@triple); |
437 | my($file) = Generate_List(@triple); |
438 | 438 | ||
439 | if (!defined($file)) { |
439 | if (!defined($file)) { |
440 | my($msg) = "Couldn't create list for $dist/$section/${arch}: "; |
440 | my($msg) = "Couldn't create list for $dist/$section/${arch}: "; |
441 | $msg .= $DebPool::Packages::Error; |
441 | $msg .= $DebPool::Packages::Error; |
442 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
442 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
443 | 443 | ||
444 | next; |
444 | next; |
445 | } |
445 | } |
446 | 446 | ||
447 | # If we're compressing distribution files, do that here. |
447 | # If we're compressing distribution files, do that here. |
448 | 448 | ||
449 | my($gzfile); |
449 | my($gzfile); |
450 | if ($Options{'compress_dists'}) { |
450 | if ($Options{'compress_dists'}) { |
451 | $gzfile = Gzip_File($file); |
451 | $gzfile = Gzip_File($file); |
452 | 452 | ||
453 | if (!defined($gzfile)) { |
453 | if (!defined($gzfile)) { |
454 | my($msg) = "Couldn't create compressed file: "; |
454 | my($msg) = "Couldn't create compressed file: "; |
455 | $msg .= $DebPool::Gzip::Error; |
455 | $msg .= $DebPool::Gzip::Error; |
456 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
456 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
457 | 457 | ||
458 | unlink($file); |
458 | unlink($file); |
459 | next; |
459 | next; |
460 | } |
460 | } |
461 | } |
461 | } |
462 | 462 | ||
463 | # If we're doing Release files, now is the time for triples. |
463 | # If we're doing Release files, now is the time for triples. |
464 | 464 | ||
465 | my($relfile); |
465 | my($relfile); |
466 | my($sigfile); |
466 | my($sigfile); |
467 | 467 | ||
468 | if ($Options{'do_release'}) { |
468 | if ($Options{'do_release'}) { |
469 | require DebPool::Release; |
469 | require DebPool::Release; |
470 | 470 | ||
471 | # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
471 | # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
472 | 472 | ||
473 | my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
473 | my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
474 | $relfile = DebPool::Release::Generate_Release_Triple( |
474 | $relfile = DebPool::Release::Generate_Release_Triple( |
475 | @triple, $release_version); |
475 | @triple, $release_version); |
476 | 476 | ||
477 | if (!defined($relfile)) { |
477 | if (!defined($relfile)) { |
478 | my($msg) = "Couldn't create Release file: "; |
478 | my($msg) = "Couldn't create Release file: "; |
479 | $msg .= $DebPool::Release::Error; |
479 | $msg .= $DebPool::Release::Error; |
480 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
480 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
481 | 481 | ||
482 | unlink($file); |
482 | unlink($file); |
483 | if (defined($gzfile)) { |
483 | if (defined($gzfile)) { |
484 | unlink($gzfile); |
484 | unlink($gzfile); |
485 | } |
485 | } |
486 | next; |
486 | next; |
487 | } |
487 | } |
488 | 488 | ||
489 | if ($Options{'sign_release'}) { |
489 | if ($Options{'sign_release'}) { |
490 | $sigfile = Sign_Release($relfile); |
490 | $sigfile = Sign_Release($relfile); |
491 | 491 | ||
492 | if (!defined($sigfile)) { |
492 | if (!defined($sigfile)) { |
493 | my($msg) = "Couldn't create Release signature file: "; |
493 | my($msg) = "Couldn't create Release signature file: "; |
494 | $msg .= $DebPool::GnuPG::Error; |
494 | $msg .= $DebPool::GnuPG::Error; |
495 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
495 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
496 | 496 | ||
497 | unlink($file); |
497 | unlink($file); |
498 | 498 | ||
499 | if (defined($gzfile)) { |
499 | if (defined($gzfile)) { |
500 | unlink($gzfile); |
500 | unlink($gzfile); |
501 | } |
501 | } |
502 | 502 | ||
503 | if (defined($relfile)) { |
503 | if (defined($relfile)) { |
504 | unlink($relfile); |
504 | unlink($relfile); |
505 | } |
505 | } |
506 | 506 | ||
507 | next; |
507 | next; |
508 | } |
508 | } |
509 | } |
509 | } |
510 | } |
510 | } |
511 | 511 | ||
512 | # Install {Packages,Sources}{,.gz} |
512 | # Install {Packages,Sources}{,.gz} |
513 | 513 | ||
514 | if (!Install_List(@triple, $file, $gzfile)) { |
514 | if (!Install_List(@triple, $file, $gzfile)) { |
515 | 515 | ||
516 | my($msg) = "Couldn't install distribution files for "; |
516 | my($msg) = "Couldn't install distribution files for "; |
517 | $msg .= "$dist/$section/${arch}: " . $DebPool::Packages::Error; |
517 | $msg .= "$dist/$section/${arch}: " . $DebPool::Packages::Error; |
518 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
518 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
519 | 519 | ||
520 | if (-e $file) { |
520 | if (-e $file) { |
521 | unlink($file); |
521 | unlink($file); |
522 | } |
522 | } |
523 | 523 | ||
524 | if (defined($gzfile) && -e $gzfile) { |
524 | if (defined($gzfile) && -e $gzfile) { |
525 | unlink($gzfile); |
525 | unlink($gzfile); |
526 | } |
526 | } |
527 | 527 | ||
528 | if (defined($relfile) && -e $relfile) { |
528 | if (defined($relfile) && -e $relfile) { |
529 | unlink($relfile); |
529 | unlink($relfile); |
530 | } |
530 | } |
531 | 531 | ||
532 | if (defined($sigfile) && -e $sigfile) { |
532 | if (defined($sigfile) && -e $sigfile) { |
533 | unlink($sigfile); |
533 | unlink($sigfile); |
534 | } |
534 | } |
535 | 535 | ||
536 | next; |
536 | next; |
537 | } |
537 | } |
538 | 538 | ||
539 | # Install Release{,.gpg} |
539 | # Install Release{,.gpg} |
540 | 540 | ||
541 | if (defined($relfile) && |
541 | if (defined($relfile) && |
542 | !DebPool::Release::Install_Release(@triple, $relfile, $sigfile)) { |
542 | !DebPool::Release::Install_Release(@triple, $relfile, $sigfile)) { |
543 | 543 | ||
544 | my($msg) = "Couldn't install release files for "; |
544 | my($msg) = "Couldn't install release files for "; |
545 | $msg .= "$dist/$section/${arch}: " . $DebPool::Release::Error; |
545 | $msg .= "$dist/$section/${arch}: " . $DebPool::Release::Error; |
546 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
546 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
547 | 547 | ||
548 | if (-e $relfile) { |
548 | if (-e $relfile) { |
549 | unlink($relfile); |
549 | unlink($relfile); |
550 | } |
550 | } |
551 | 551 | ||
552 | if (defined($sigfile) && -e $sigfile) { |
552 | if (defined($sigfile) && -e $sigfile) { |
553 | unlink($sigfile); |
553 | unlink($sigfile); |
554 | } |
554 | } |
555 | 555 | ||
556 | next; |
556 | next; |
557 | } |
557 | } |
558 | 558 | ||
559 | my($pushfile) = Archfile(@triple, 0); |
559 | my($pushfile) = Archfile(@triple, 0); |
560 | $pushfile =~ s/${dist}\///; |
560 | $pushfile =~ s/${dist}\///; |
561 | push(@rel_filelist, $pushfile); |
561 | push(@rel_filelist, $pushfile); |
562 | 562 | ||
563 | if (defined($gzfile)) { |
563 | if (defined($gzfile)) { |
564 | push(@rel_filelist, $pushfile . '.gz'); |
564 | push(@rel_filelist, $pushfile . '.gz'); |
565 | } |
565 | } |
566 | 566 | ||
567 | if (defined($relfile)) { |
567 | if (defined($relfile)) { |
568 | $pushfile = Archfile(@triple, 1); |
568 | $pushfile = Archfile(@triple, 1); |
569 | $pushfile =~ s/${dist}\///; |
569 | $pushfile =~ s/${dist}\///; |
570 | $pushfile .= '/Release'; |
570 | $pushfile .= '/Release'; |
571 | push(@rel_filelist, $pushfile); |
571 | push(@rel_filelist, $pushfile); |
572 | 572 | ||
573 | if (defined($sigfile)) { |
573 | if (defined($sigfile)) { |
574 | push(@rel_filelist, $pushfile . '.gpg'); |
574 | push(@rel_filelist, $pushfile . '.gpg'); |
575 | } |
575 | } |
576 | } |
576 | } |
577 | } |
577 | } |
578 | } |
578 | } |
579 | 579 | ||
580 | # If we're doing Release files, now is the time for the general dist one. |
580 | # If we're doing Release files, now is the time for the general dist one. |
581 | 581 | ||
582 | my($relfile); |
582 | my($relfile); |
583 | my($sigfile); |
583 | my($sigfile); |
584 | 584 | ||
585 | if ($Options{'do_release'}) { |
585 | if ($Options{'do_release'}) { |
586 | require DebPool::Release; |
586 | require DebPool::Release; |
587 | 587 | ||
588 | # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
588 | # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
589 | 589 | ||
590 | my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
590 | my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
591 | $relfile = DebPool::Release::Generate_Release_Dist( |
591 | $relfile = DebPool::Release::Generate_Release_Dist( |
592 | $dist, $release_version, @rel_filelist); |
592 | $dist, $release_version, @rel_filelist); |
593 | 593 | ||
594 | if (!defined($relfile)) { |
594 | if (!defined($relfile)) { |
595 | my($msg) = "Couldn't create Release file: "; |
595 | my($msg) = "Couldn't create Release file: "; |
596 | $msg .= $DebPool::Release::Error; |
596 | $msg .= $DebPool::Release::Error; |
597 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
597 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
598 | } else { |
598 | } else { |
599 | if ($Options{'sign_release'}) { |
599 | if ($Options{'sign_release'}) { |
600 | $sigfile = Sign_Release($relfile); |
600 | $sigfile = Sign_Release($relfile); |
601 | 601 | ||
602 | if (!defined($sigfile)) { |
602 | if (!defined($sigfile)) { |
603 | my($msg) = "Couldn't create Release signature file: "; |
603 | my($msg) = "Couldn't create Release signature file: "; |
604 | $msg .= $DebPool::GnuPG::Error; |
604 | $msg .= $DebPool::GnuPG::Error; |
605 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
605 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
606 | unlink($relfile); |
606 | unlink($relfile); |
607 | $relfile = undef; |
607 | $relfile = undef; |
608 | } |
608 | } |
609 | } |
609 | } |
610 | } |
610 | } |
611 | } |
611 | } |
612 | 612 | ||
613 | # Install Release{,.gpg} |
613 | # Install Release{,.gpg} |
614 | 614 | ||
615 | if (defined($relfile) && |
615 | if (defined($relfile) && |
616 | !DebPool::Release::Install_Release($dist, undef, undef, |
616 | !DebPool::Release::Install_Release($dist, undef, undef, |
617 | $relfile, $sigfile)) { |
617 | $relfile, $sigfile)) { |
618 | my($msg) = "Couldn't install release files for "; |
618 | my($msg) = "Couldn't install release files for "; |
619 | $msg .= "${dist}: " . $DebPool::Release::Error; |
619 | $msg .= "${dist}: " . $DebPool::Release::Error; |
620 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
620 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
621 | 621 | ||
622 | if (-e $relfile) { |
622 | if (-e $relfile) { |
623 | unlink($relfile); |
623 | unlink($relfile); |
624 | } |
624 | } |
625 | 625 | ||
626 | if (defined($sigfile) && -e $sigfile) { |
626 | if (defined($sigfile) && -e $sigfile) { |
627 | unlink($sigfile); |
627 | unlink($sigfile); |
628 | } |
628 | } |
629 | } |
629 | } |
630 | } |
630 | } |
631 | 631 | ||
632 | # Close out the databases, ensuring that they're flushed to disk. We'll |
632 | # Close out the databases, ensuring that they're flushed to disk. We'll |
633 | # just reopen them in a moment, if we're in daemon mode; it's still good to |
633 | # just reopen them in a moment, if we're in daemon mode; it's still good to |
634 | # write them out. |
634 | # write them out. |
635 | 635 | ||
636 | Close_Databases(); |
636 | Close_Databases(); |
637 | 637 | ||
638 | # This will short-circuit if we catch a signal while sleeping. |
638 | # This will short-circuit if we catch a signal while sleeping. |
639 | 639 | ||
640 | if ($Options{'daemon'}) { |
640 | if ($Options{'daemon'}) { |
641 | Log_Message("Waiting on changes to incoming dir.", LOG_GENERAL, LOG_DEBUG); |
641 | Log_Message("Waiting on changes to incoming dir.", LOG_GENERAL, LOG_DEBUG); |
642 | 642 | ||
643 | if (!Monitor_Incoming()) { |
643 | if (!Monitor_Incoming()) { |
644 | my($msg) = "Error in Monitor_Incoming: " . $DebPool::Dirs::Error; |
644 | my($msg) = "Error in Monitor_Incoming: " . $DebPool::Dirs::Error; |
645 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
645 | Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
646 | } |
646 | } |
647 | } |
647 | } |
648 | 648 | ||
649 | # End of MAIN_LOOP; we loop back until either we're not in daemon mode |
649 | # End of MAIN_LOOP; we loop back until either we're not in daemon mode |
650 | # (that is, we've been told to single-pass), or until we catch a signal. |
650 | # (that is, we've been told to single-pass), or until we catch a signal. |
651 | 651 | ||
652 | } until ((!$Options{'daemon'}) || $Signal_Caught); |
652 | } until ((!$Options{'daemon'}) || $Signal_Caught); |
653 | 653 | ||
654 | # Release our lock |
654 | # Release our lock |
655 | 655 | ||
656 | unlink($Options{'lock_file'}); |
656 | unlink($Options{'lock_file'}); |
657 | 657 | ||
658 | Log_Message("Exiting.", LOG_GENERAL, LOG_DEBUG); |
658 | Log_Message("Exiting.", LOG_GENERAL, LOG_DEBUG); |
659 | 659 | ||
660 | exit(0); |
660 | exit(0); |
661 | 661 | ||
662 | __END__ |
662 | __END__ |
663 | 663 | ||
664 | # vim:set tabstop=4 expandtab: |
664 | # vim:set tabstop=4 expandtab: |