/branches/magnus/trunk/LICENSE |
---|
0,0 → 1,25 |
Copyright © 2003-2004 Joel Aelwyn. All rights reserved. |
Redistribution and use in source and binary forms, with or without |
modification, are permitted provided that the following conditions |
are met: |
1. Redistributions of source code must retain the above copyright |
notice, this list of conditions and the following disclaimer. |
2. Redistributions in binary form must reproduce the above copyright |
notice, this list of conditions and the following disclaimer in the |
documentation and/or other materials provided with the distribution. |
3. Neither the name of the Author nor the names of any contributors |
may be used to endorse or promote products derived from this software |
without specific prior written permission. |
THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
SUCH DAMAGE. |
/branches/magnus/trunk/debian/control |
---|
0,0 → 1,28 |
Source: debpool |
Section: devel |
Priority: extra |
Maintainer: Joel Aelwyn <fenton@debian.org> |
Standards-Version: 3.7.2.0 |
Build-Depends: debhelper (>= 4) |
Package: debpool |
Architecture: all |
Depends: ${perl:Depends} |
Recommends: gnupg, libdigest-md5-perl, libdigest-sha1-perl, libproc-daemon-perl |
Description: pool-based Debian package archiver |
DebPool is a package archive maintenance utility designed with a goal of |
removing any dependency on code not shipped as part of the core Debian |
system. |
. |
It is capable of all of the following: |
* Tracking multiple distributions (however, it does *not* include |
unstable -> testing promotion scripts). |
* Generating Release files (requires libdigest-{md5,sha1}-perl) |
* Verifying package signatures (requires gnupg). |
* Signing release files (requires Release files and gnupg). |
* Running in single-pass or daemon modes. |
. |
DebPool is intended to be a lightweight replacement for the full Debian |
archival scripts, in the tradition of debarchive and mini-dinstall, but |
using a pool layout and avoiding external dependencies. |
/branches/magnus/trunk/debian/compat |
---|
0,0 → 1,0 |
4 |
/branches/magnus/trunk/debian/debpool.dirs |
---|
0,0 → 1,14 |
etc |
etc/debpool |
usr |
usr/bin |
usr/share |
usr/share/debpool |
usr/share/debpool/perl5 |
usr/share/doc/debpool |
usr/share/doc/debpool/examples |
usr/share/man |
usr/share/man/man5 |
var |
var/cache |
var/cache/debpool |
/branches/magnus/trunk/debian/changelog |
---|
0,0 → 1,187 |
debpool (0.2.3) experimental; urgency=low |
* Handle sections with no subsection more usefully in |
Strip_Subsection. (Closes: #317390, #319959) |
* Refactor various bits to use Strip_Subsection, rather than re- |
implementing it badly. I don't know what on earth I was thinking, |
but things should behave better now. (Closes: #320062) |
* Don't hardcode the pool base path as 'pool'; determine it from |
archive_dir and pool_dir, instead. (Closes: #323625) |
* Updated to Policy 3.7.2.0 (no changes). |
* Moved dependancy on debhelper from Build-Depends-Indep to Build- |
Depends (to shut up various build tools). |
-- Joel Aelwyn <fenton@debian.org> Mon, 3 Jul 2006 12:08:12 -0600 |
debpool (0.2.2) experimental; urgency=low |
* Handle stripping of epoch versions where they aren't used. |
* Properly handle each possibly version type (meta or 'package' |
version, source version, binary version(s)). This change is |
backward-compatible, but old version information will only work as |
well as it did in previous releases (that is, all of the versions |
are assumed to have the same value for a given package version). |
-- Joel Aelwyn <fenton@debian.org> Wed, 23 Feb 2005 10:47:20 -0700 |
debpool (0.2.1) experimental; urgency=low |
* Added proper support for archive sections (contrib, non-free as |
separate from main). Unfortunately, this means changing the |
directory structure of the pool area. Thus, bumping to version to |
0.2.x |
* Rewrite and re-enable auditing of package area when a new version is |
installed (or, in short, 'discard old package versions'). |
* Make the GnuPG module dynamically detect the GnuPG header, as it |
already did for the trailer, rather than always assuming it is a |
single size. While I can't replicate the situation, it appears to |
not be true on some architecture/version combinations. |
(Closes: #294945) |
-- Joel Aelwyn <fenton@debian.org> Mon, 21 Feb 2005 13:27:09 -0700 |
debpool (0.1.11) experimental; urgency=low |
* Handle origional tarballs more strictly; if the Changes file claims |
to have one, treat it as the only valid source; if not, treat the |
pool as the only valid source. (No bug) |
* Added support for virtual distributions (testing-volatile, unstable- |
ganneff, etc) which are remapped to normal distributions at upload. |
(Closes: #275642) |
* Support Section and Priority fields for Source packages (uses the |
values found on the DSC file line in the Changes file). (No bug; |
TODO) |
* Fixed a couple of problems that occured when sign_release was |
enabled. I don't know what I was smoking when I wrote those bits of |
code, but it must have been good. (Closes: #291809) |
-- Joel Aelwyn <fenton@debian.org> Tue, 25 Jan 2005 23:46:59 -0700 |
debpool (0.1.10) experimental; urgency=low |
* Fixes for incorrect information in README.User (Closes: #291151) |
* Added timestamp to log entries. (Closes: #291055) |
* Fixed bad built-in default value for sleep time in daemon mode (was |
0, should have been 300 seconds / 5 minutes). (Closes: #291152) |
* If we reject a package, skip to the next one; everything else is |
pointless (and will just generate useless errors in the logs). (No |
bug) |
* Added special case handling for DSC file MD5Sum validations; the |
orig tarball is allowed to appear in this file, but must be checked |
in the pool, rather than in the incoming directory, if it already |
exists. (Closes: #291036) |
-- Joel Aelwyn <fenton@debian.org> Wed, 19 Jan 2005 14:28:27 -0700 |
debpool (0.1.9) experimental; urgency=low |
* Correct the fact that the debhelper control file debpool.docs was |
completely missing. Definite oops. Also, move 'README' to |
'README.Debian' for general consistance with other packages, as this |
is Debian-specific information. (Closes: #285751) |
-- Joel Aelwyn <fenton@debian.org> Wed, 12 Jan 2005 22:45:00 -0700 |
debpool (0.1.8) experimental; urgency=low |
* Fixed a regex bug in Packages module which caused things to fail |
when a dpkg info field was only 1 character long (most often |
Installed-Size: 0, or at least < 10). (Closes: #274060) |
-- Joel Aelwyn <fenton@debian.org> Thu, 14 Oct 2004 19:06:58 -0600 |
debpool (0.1.7) experimental; urgency=low |
* Fix documentation bug regarding command-line options. |
(Closes: #257447) |
* Include README files in docs. (Closes: #254301) |
* Updated maintainer name (same person, legal name change only). |
* Fixed call from Logging to DB::Close_Databases problem when trying |
to bail on fatal logging errors so that it works now, rather than |
producing a secondary error. (Closes: #275760) |
* Include .dsc file information in Sources records. (Closes: #276232) |
* Fixed a reported typo in an error message in the GnuPG module. |
(Closes: #271529) |
* Fixed an improperly bound call to Release::Install_Release in the |
case of a failed GnuPG signature on the Release file. |
(Closes: #254300) |
-- Joel Aelwyn <fenton@debian.org> Thu, 14 Oct 2004 15:29:51 -0600 |
debpool (0.1.6) experimental; urgency=low |
* Forcibly protect + characters when dealing with regex matching. |
Oops. (Closes: #248189) |
* Fixed problem with not reporting the (optional but very important if |
present) Essential header. Based on patch submitted by Frederick |
Schueler. (Closes: #248766, #248585) |
-- Joel Baker <fenton@debian.org> Fri, 14 May 2004 09:25:42 -0600 |
debpool (0.1.5) experimental; urgency=low |
* Cope properly with things when package filename version numbers do |
not match source version numbers (anything with an epoch, and some |
oddities like gcc-defaults). (Closes: #245180) |
* Switch away from trying to move files at all, even using |
File::Copy's move - too many issues with it. Use a copy/chmod/unlink |
series (wrapped up in DebPool::Util::Move_File) instead. |
(Closes: #247191) |
* Generate distribution top-level Release files, including optional |
signatures. (Closes: #247025) |
* Switch to using File::Temp for tempfile management, since it is in |
the standard core as of 5.6, so we can depend on it being present, |
and it's much cleaner than using Fcntl and tmpnam to manually do the |
same. (No bug specifically against this, but it should fix the |
'Subroutine O_*' error messages reported in bug #245180). |
-- Joel Baker <fenton@debian.org> Thu, 6 May 2004 16:13:15 -0600 |
debpool (0.1.4) experimental; urgency=low |
* Handle non-existant distributions correctly. (Closes: #245132) |
* Fork to avoid reader deadlocks when running external processes via |
open2. I'd prefer threads, but I don't trust perl's threading much. |
(Closes: #245843) |
* Fix serious issue with dropping the first entry in the changes file. |
(Closes: #245896) |
-- Joel Baker <fenton@debian.org> Sun, 25 Apr 2004 20:36:15 -0600 |
debpool (0.1.3) experimental; urgency=low |
* Handle binary-only uploads correctly. (No bug filed) |
-- Joel Baker <fenton@debian.org> Sun, 18 Apr 2004 17:02:43 -0600 |
debpool (0.1.2) experimental; urgency=low |
* Print a separator newline after every package in the Packages file, |
not after every set of packages. (No bug filed) |
* Use the package name, not the source name, when trying to scan for |
the upload file. Duh. (No bug filed) |
* Removed an erroneous error logging message; it really is OK to have |
some architectures without some packages (in particular, binary-* |
and 'all' should never occur together). |
-- Joel Baker <fenton@debian.org> Thu, 15 Apr 2004 16:39:40 -0600 |
debpool (0.1.1) experimental; urgency=low |
* Updated to Policy 3.6.1 (no changes). |
* Fixed use of deprecated hashref semantics. |
* Use non-deprecated perl version requirement form. |
* Package file entries should no longer run together; stupid error |
printing to the wrong file handle. (Closes: #242435) |
* Use File::Copy::move() instead of rename() when moving files, to |
deal with cross-filesystem moves properly. (Closes: #230510) |
* Switched from Build-Depends to Build-Depends-Indep; not sure if I |
agree this makes sense, but linda is being loud about it, so. |
-- Joel Baker <fenton@debian.org> Thu, 15 Apr 2004 11:12:30 -0600 |
debpool (0.1.0) experimental; urgency=low |
* Initial upload (to experimental). (Closes: #200654) |
-- Joel Baker <fenton@debian.org> Tue, 7 Oct 2003 09:16:09 -0600 |
/branches/magnus/trunk/debian/debpool.install |
---|
0,0 → 1,3 |
examples/Config.pm etc/debpool |
bin/debpool usr/bin |
share/DebPool usr/share/debpool/perl5 |
/branches/magnus/trunk/debian/rules |
---|
0,0 → 1,43 |
#! /usr/bin/make -f |
# TODO: Switch to CDBS |
# |
# TODO: Auto-generate DebPool::Config (with pod2man, options: |
# --section=5 --name="DebPool::Config" --center="DebPool Configuration") |
build: |
dh_testdir |
binary-arch: |
@echo "No arch-dependant files to build" |
binary-indep: build |
dh_testdir |
dh_testroot |
dh_installdirs -i |
dh_install -i |
dh_installdocs -i |
dh_installexamples -i |
dh_installchangelogs -i |
dh_installman -i |
dh_perl -i |
dh_compress -i |
dh_fixperms -i |
dh_md5sums -i |
dh_gencontrol -i |
dh_installdeb -i |
dh_builddeb -i |
binary: binary-indep |
clean: |
dh_testdir |
dh_testroot |
dh_clean |
.PHONY: binary binary-arch binary-indep build clean |
Property changes: |
Added: svn:executable |
Index: trunk/debian/debpool.examples |
=================================================================== |
--- trunk/debian/debpool.examples (nonexistent) |
+++ trunk/debian/debpool.examples (revision 3) |
@@ -0,0 +1 @@ |
+examples/Config.pm |
Index: trunk/debian/README.Why |
=================================================================== |
--- trunk/debian/README.Why (nonexistent) |
+++ trunk/debian/README.Why (revision 3) |
@@ -0,0 +1,33 @@ |
+Why have yet another Debian package repository tool? |
+ |
+* Most or all of the other tools require extensive non-core support. |
+ |
+ While many users may not find this problematic, those working on a new |
+ port, and trying to make it self-hosting, will often have a difficult |
+ time trying to get some of the more packages with a complex tree of |
+ Build-Dependancies (such as Python) to a point where they can be |
+ compiled. Conversely, a working shell, an installation of Perl, and |
+ a compiler are some of the first things that must be present, simply |
+ because so much of the rest of the system depends on these (and they are |
+ often available from another port or a non-Debian system). |
+ |
+ Therefore, I have attempted to keep the requirements for packages not |
+ found in the Debian core system (Essential packages, or those with |
+ Priority required) to an absolute minimum (ideally, 'none'), or at the |
+ very least, only require packages that can easily be compiled on a system |
+ with little more than a shell, perl, and a working C compiler. |
+ |
+ Note that some amount of significant functionality (such as Release |
+ files and signature checking) does depend on more complex packages (such |
+ as GnuPG or the perl Digest modules), which is why these are in the |
+ Recommends field; however, these functions that use these are niceties |
+ (if very useful ones), and an archive can operate without them, if |
+ necessary. |
+ |
+* No other tool handles the new pool-style layout readily. |
+ |
+ As of this writing, none of the tools in Debian except for katie (part |
+ of the softare used to run the primary Debian archives) can handle a |
+ pool-style directory layout in any straightforward fashion, while setting |
+ up a full instance of katie requires significant support infrastructure |
+ (such as an SQL server, among other things). |
Index: trunk/debian/TODO |
=================================================================== |
--- trunk/debian/TODO (nonexistent) |
+++ trunk/debian/TODO (revision 3) |
@@ -0,0 +1,37 @@ |
+Items which still need to be done: |
+ |
+(general) |
+ |
+* Support tools for manipulating metadata (which really means 'anything |
+ stored in database files'). |
+ |
+* Support rebuild-dbs (including invocation from rebuild-all)? |
+ - What can this do with stuff that has migrated between distributions? |
+ |
+(for debian-installer support) |
+ |
+* Handle udeb packages correctly (entries go into |
+ dists/<dist>/<section>/debian-installer/<binary>/Packages instead of |
+ dists/<dist>/<section>/<binary>/Packages) |
+ |
+(for hooks) |
+ |
+* Hooks |
+ - Installation |
+ - Rejection |
+ - Byhand (with some sort of requeue? Or "byhand MUST be missing"?) |
+ |
+ |
+(for sane binary-all) |
+ |
+* Support an external source for binary-all data (for example, snarfing it |
+ out of a Packages file from http.us.debian.org). |
+ |
+(unknown) |
+ |
+* Integrate with (or emulate) debsig-verify, to allow for verification of |
+ signed deb files (in addition to signed metadata). |
+ |
+* Some way to double-parse values in $archive (allowing the equivalent of |
+ relative path references from archive_dir, so that changes are reflected |
+ in all other paths by default). |
Index: trunk/debian/copyright |
=================================================================== |
--- trunk/debian/copyright (nonexistent) |
+++ trunk/debian/copyright (revision 3) |
@@ -0,0 +1,34 @@ |
+This is a Debian Native package. |
+ |
+DebPool is Copyright © 2003-2004 by Joel Aelwyn (aka Joel Baker), and is |
+released under the following license: |
+ |
+##### |
+# |
+# Copyright © 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+##### |
Index: trunk/debian/README.User |
=================================================================== |
--- trunk/debian/README.User (nonexistent) |
+++ trunk/debian/README.User (revision 3) |
@@ -0,0 +1,67 @@ |
+Basic instructions for setting up a system-wide debpool archive with a |
+debpool user/group: |
+ |
+1. Create a debpool user and group by using the command: |
+ |
+ adduser --system --group --shell /bin/bash |
+ --gecos 'Debian Pool Manager' debpool |
+ |
+ (Note that the command should be entered on one line; it is broken into |
+ two parts for the ease of reading). |
+ |
+2. If you do not wish to use /var/cache/debpool (the default location), you |
+ must create a directory where you want the archive to be placed, and set |
+ it's user/group appropriately. For example: |
+ |
+ sudo mkdir /export/debpool |
+ sudo chown debpool:debpool /export/debpool |
+ sudo chmod a+rx /export/debpool |
+ |
+ If you do wish to use /var/cache/debpool, it will need to be made |
+ accessible to the debpool user and group. The only supported method of |
+ doing this is to use dpkg-statoverride, as follows: |
+ |
+ dpkg-statoverride --update --add debpool debpool 0755 /var/cache/debpool |
+ |
+3. Create a logfile directory for debpool. The two most common choices are |
+ /var/log/debpool (which mimics normal "system" log behavior), or |
+ /home/debpool/.debpool (which mimics user-installation log behavior |
+ on a default Debian system setup). Note this location for use in step 4. |
+ |
+ For example: |
+ |
+ sudo mkdir /var/log/debpool |
+ sudo chown debpool:debpool /var/log/debpool |
+ sudo chmod a+rx /var/log/debpool |
+ |
+4. Edit /etc/debpool/Config.pm. The following items are of particular note: |
+ |
+ * archive-dir (the archive directory chosen in step 2) |
+ - You may wish to double-check the *_mode settings as well |
+ * log_file (should reside in the directory chosen in step 3) |
+ |
+ Run debpool once, to check that all of your configuration values are |
+ correct, and to create the directory structure. For example: |
+ |
+ sudo su - debpool /usr/bin/debpool |
+ |
+5. Edit the crontab for user debpool, using the command: |
+ |
+ sudo crontab -u debpool -e |
+ |
+ You should add one of the following two sets of crontab entries to the |
+ file, depending on how you want to run debpool: |
+ |
+ (Periodic mode; example fires off hourly, at 13 minutes past the hour) |
+ |
+ @reboot /usr/bin/debpool --nodaemon |
+ 13 * * * * /usr/bin/debpool --nodaemon |
+ |
+ (Daemon mode; fire off only on restart. Note that this should all be one |
+ line, without the \, prefferably) |
+ |
+ @reboot /usr/bin/debpool --daemon |
+ |
+ Note that the command line options given here will override any other |
+ configurations, including those found in /etc/debpool/Config.pm, |
+ ~/.debpool/Config.pm, and the default configurations. |
Index: trunk/debian/debpool.docs |
=================================================================== |
--- trunk/debian/debpool.docs (nonexistent) |
+++ trunk/debian/debpool.docs (revision 3) |
@@ -0,0 +1,3 @@ |
+debian/README.GnuPG |
+debian/README.User |
+debian/README.Why |
Index: trunk/debian/README.GnuPG |
=================================================================== |
--- trunk/debian/README.GnuPG (nonexistent) |
+++ trunk/debian/README.GnuPG (revision 3) |
@@ -0,0 +1,70 @@ |
+Basic instructions for setting up GnuPG: |
+ |
+1. Make sure that the gnupg package is installed. |
+ |
+[ If you're using a system-wide debpool user, do all of these in that ] |
+[ account! ] |
+ |
+2. Run gpg twice, with an empty input, to make sure that it creates it's |
+ options file and keyrings. On a new account, this should look something |
+ like the following: |
+ |
+ $ echo -n "" | gpg |
+ gpg: /home/debpool/.gnupg: directory created |
+ gpg: /home/debpool/.gnupg/options: new options file created |
+ gpg: you have to start GnuPG again, so it can read the new options file |
+ $ echo -n "" | gpg |
+ gpg: /home/debpool/.gnupg/secring.gpg: keyring created |
+ gpg: /home/debpool/.gnupg/pubring.gpg: keyring created |
+ gpg: processing message failed: eof |
+ |
+3. Create a primary key, using the 'gpg --gen-key' command. |
+ |
+ NOTE: you don't want to use this key to sign the Release files, if |
+ you're doing that; we'll do that later. |
+ |
+ NOTE: You can skip this step if you're running debpool on your own |
+ account, and you already have a primary key. |
+ |
+4. Import public keys onto one of the uploader keyrings for each |
+ person allowed to upload packages to the archive. Current keys |
+ for Debian Developers can be downloaded from the keyserver at |
+ keyring.debian.org; others must be downloaded from public servers, or |
+ obtained directly from the person in question. The default keyring |
+ to search is 'uploaders.gpg'; this can be changed by adjusting |
+ $Options{'gpg_keyrings'}. |
+ |
+ Don't forget to create the keyring; doing 'touch ~/.gnupg/uploaders.gpg' |
+ should suffice. |
+ |
+ Note that signature verification WILL NOT use your default keyring; if |
+ you want it to be checked, you must add it to 'gpg_keyrings' explicitly. |
+ |
+ Keys can be imported by the command 'gpg --no-default-keyring --keyring |
+ uploaders.gpg --keyring pubring.gpg --import <keyfile>' (or '--import |
+ <keyfile>' can be replaced with '--keyserver <server> --recv-keys |
+ <key ID>'). Note that --no-default-keyring is required to prevent the |
+ main keyring (which will not normally be searched) from being the |
+ default keyring while importing, but that GnuPG won't handle trustdb |
+ updates unless it has the public key that matches the default secret |
+ key (normally found in ~/.gnupg/pubring.gpg, which is listed *after* |
+ uploaders.gpg so that it will still be searched). |
+ |
+[ If you're only using GPG signature verification, you can stop here. The ] |
+[ rest of this file deals with setting debpool up to do automatic signing ] |
+[ of Release files. ] |
+ |
+5. Generate an archive signing key using 'gpg --gen-key', and record the |
+ passphrase in ~/.gnupg/passphrase (make sure it's mode 0600!) |
+ |
+ Yes, this violates traditional practice, but there isn't any other |
+ way to automatically sign the Release file (though, if you care, you |
+ could always manually sign the Release file after each archive run, or |
+ turn off debpool's Release file generation and manully generate/sign a |
+ Release file for each section). |
+ |
+6. Edit the appropriate Config.pm file (/etc/debpool/Config.pm or |
+ ~/.debpool/Config.pm), set $Options{'sign_release'} to 1 and |
+ $Options{'gpg_sign_key'} to the key ID of your archive signing key. |
+ Note that this won't have any effect unless you also enable Release |
+ file generation (but it won't hurt anything, either). |
Index: trunk/debian/NEWS |
=================================================================== |
--- trunk/debian/NEWS (nonexistent) |
+++ trunk/debian/NEWS (revision 3) |
@@ -0,0 +1,20 @@ |
+debpool (0.2.1) experimental; urgency=low |
+ |
+ * A major change (support for automatic section detection) has been |
+ introduced between version 0.1.11 and version 0.2.1. This change |
+ causes a change in archive directory layout (specifically, now has a |
+ subdirectory for each of the sections defined in the config file), |
+ making it look more like the traditional Debian archive. Existing |
+ installations will need to do one of two things to cope with this: |
+ |
+ 1) Move each package directory into the new pool area, and update any |
+ *.package and *.source files to have the correct path to the new pool |
+ area, then run debpool --rebuild-files, |
+ |
+ or |
+ |
+ 2) Start a new archive area and dump installed/* and pool/*/* into |
+ the incoming directory, optionally pare out redundant versions, and |
+ then run 'debpool' to re-build the archive. |
+ |
+ -- Joel Aelwyn <fenton@debian.org> Mon, 21 Feb 2005 13:27:09 -0700 |
Index: trunk/debian/debpool.manpages |
=================================================================== |
--- trunk/debian/debpool.manpages (nonexistent) |
+++ trunk/debian/debpool.manpages (revision 3) |
@@ -0,0 +1 @@ |
+man/man*/* |
Index: trunk/debian/README.Debian |
=================================================================== |
--- trunk/debian/README.Debian (nonexistent) |
+++ trunk/debian/README.Debian (revision 3) |
@@ -0,0 +1,9 @@ |
+Important notes about using debpool: |
+ |
+* For archives using any of the extended features (in particular, any of |
+ the GnuPG-based signature verification or Release signing capabilities), |
+ it is strongly advised that you run debpool under it's own user. See |
+ README.User for more information on doing this. |
+ |
+* For setting up signature verification or Release signing, please see the |
+ README.GnuPG file. |
Index: trunk/share/DebPool/Config.pm |
=================================================================== |
--- trunk/share/DebPool/Config.pm (nonexistent) |
+++ trunk/share/DebPool/Config.pm (revision 3) |
@@ -0,0 +1,966 @@ |
+package DebPool::Config; |
+ |
+### |
+# |
+# DebPool::Config - Module for handling config options |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Config.pm 38 2005-01-20 21:33:31Z joel $ |
+# |
+### |
+ |
+=head1 NAME |
+ |
+DebPool::Config - configuration file format for debpool |
+ |
+=cut |
+ |
+=head1 SYNOPSIS |
+ |
+package DebPool::Config; |
+ |
+%Options = ( |
+ 'option1' => value1, |
+ 'option2' => value2, |
+ ... |
+); |
+ |
+1; |
+ |
+=cut |
+ |
+=head1 DESCRIPTION |
+ |
+The DebPool::Config file is normally found in three places; |
+F</usr/share/debpool/Config.pm>, F</etc/debpool/Config.pm>, and |
+F<$HOME/.debpool/Config.pm> (in ascending order of precedence); |
+further locations can also be specified on the command line with the |
+'--config=<file>' option, which overrides all of these (and is, in turn, |
+overridden by any command line options). Also of note is the --nodefault |
+option, which prevents any attempt at loading the default (system and user) |
+config files. |
+ |
+The config files in /etc/debpool and $HOME/.debpool are not required to be |
+full Perl modules, though they must still declare a package namespace of |
+'DebPool::Config' and return a true value. |
+ |
+=cut |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ %Options |
+ %OptionDefs |
+ &Clean_Options |
+ &Load_Default_Configs |
+ &Load_Minimal_Configs |
+ &Load_File_Configs |
+ &Override_Configs |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Clean_Options &Load_Default_Configs |
+ &Load_Minimal_Configs &Load_File_Configs |
+ &Override_Configs)], |
+ 'vars' => [qw(%Options %OptionDefs)], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# The core of everything this package is about. |
+ |
+our(%Options); |
+our(%OptionDefs); |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Load_Default_Configs |
+# |
+# Loads the internal default values into %Options via |
+# Load_Internal_Configs, then 'require's config files from the default |
+# locations. It would be nice if we could log errors, but we can't safely |
+# load the logging module until we have all the configs in place. Catch-22. |
+ |
+sub Load_Default_Configs { |
+ Load_Internal_Configs(); |
+ |
+ if (-r '/etc/debpool/Config.pm') { |
+ require '/etc/debpool/Config.pm'; # System defaults |
+ } |
+ |
+ if (-r "$ENV{'HOME'}/.debpool/Config.pm") { |
+ require "$ENV{'HOME'}/.debpool/Config.pm"; # User defaults |
+ } |
+} |
+ |
+# Load_Minimal_Configs |
+# |
+# Loads only the minimum configs necessary to be able to do parsing - |
+# that is, populate %OptionDefs. However, for sanity sake in documenting |
+# things, this has a side effect of also loading %Options, so we clear it |
+# afterwards. |
+ |
+sub Load_Minimal_Configs { |
+ Load_Internal_Configs(); |
+ |
+ undef(%Options); |
+} |
+ |
+# Load_File_Configs($file) |
+# |
+# Loads configuration data from $file. We don't check for readability; if |
+# the user is insane enough to ask for a non-existant file, just die and |
+# tell them that they're stupid. Note: if this routine is called while a |
+# lockfile is held, it won't clean that up if we die. |
+ |
+sub Load_File_Configs { |
+ require "$_[0]"; |
+} |
+ |
+# Override_Configs($override_hashref) |
+# |
+# Overrides current values in %Options (whatever those might be) with the |
+# values in the hash. Does not destroy unnamed values. |
+ |
+sub Override_Configs { |
+ my($hashref) = @_; |
+ my($key); |
+ |
+ foreach $key (keys(%{$hashref})) { |
+ $Options{$key} = $hashref->{$key}; |
+ } |
+} |
+ |
+# Clean_Options() |
+# |
+# Does some cleanup of $Options for sanity sake; also generates some |
+# auto-calculated values. |
+ |
+sub Clean_Options { |
+ # Clean up the architectures field; 'source' should always be present, |
+ # 'all' should never be. Simplest way to manage this is a throwaway |
+ # hash. This should maybe live somewhere else, but I'm not sure where. |
+ |
+ my(%dummy); |
+ my($dummykey); |
+ my(@newarch); |
+ |
+ foreach $dummykey (@{$Options{'archs'}}) { |
+ $dummy{$dummykey} = 1; |
+ } |
+ |
+ $dummy{'all'} = undef; |
+ $dummy{'source'} = 1; |
+ |
+ foreach $dummykey (keys(%dummy)) { |
+ if ($dummy{$dummykey}) { |
+ push(@newarch, $dummykey); |
+ } |
+ } |
+ |
+ $Options{'archs'} = \@newarch; |
+ |
+ # Generate 'realdists' from %Options{'dists'} - these are the 'real' |
+ # (non-alias) distribution values. |
+ |
+ %dummy = (); |
+ |
+ foreach $dummykey (values(%{$Options{'dists'}})) { |
+ $dummy{$dummykey} = 1; |
+ } |
+ |
+ my(@realdists) = keys(%dummy); |
+ $Options{'realdists'} = \@realdists; |
+ |
+ # Also generate a reverse-lookup table of real -> alias; in the case |
+ # of multiple aliases, the first one encountered wins (one of them has |
+ # to, and making it consistant and first means you can have multiple |
+ # aliases in a sensible order). |
+ |
+ my(%reverse) = (); |
+ foreach $dummykey (keys(%{$Options{'dists'}})) { |
+ my($real) = $Options{'dists'}->{$dummykey}; |
+ if (!defined($reverse{$real})) { |
+ $reverse{$real} = $dummykey; |
+ } |
+ } |
+ |
+ $Options{'reverse_dists'} = \%reverse; |
+ |
+ # Enable releases if we have all of the pieces. |
+ if (defined($Options{'release_origin'}) |
+ && defined($Options{'release_label'}) && |
+ defined($Options{'release_description'})) { $Options{'do_release'} = 1; |
+ } else { $Options{'do_release'} = 0; } |
+ |
+ # If rebuild-all is present, turn on various rebuild options. |
+ |
+ if ($Options{'rebuild-all'}) { |
+ $Options{'rebuild-files'} = 1; |
+ $Options{'rebuild-dbs'} = 1; |
+ } |
+} |
+ |
+# Load_Internal_Configs() |
+# |
+# Loads %Options with basic default values. |
+ |
+sub Load_Internal_Configs { |
+=head1 OPTIONS |
+ |
+=head2 File/Directory configuration |
+ |
+These config values determine what directories various parts of the archive |
+are put in, and what permissions those directories have, as well as the |
+default permissions for files. |
+ |
+NOTE: While debpool will attempt to create db_dir, dists_dir, incoming_dir, |
+installed_dir, pool_dir, and reject_dir if they do not exist, it will *not* |
+attempt to do this for archive_dir. |
+ |
+WARNING: If you redefine archive_dir and you want the other four entries to |
+reflect this by incorporating the new value, you *MUST* redefine them here |
+(even if you simply use the default value of 'archive_dir'/<dirname>) so |
+that they use the new definition of archive_dir. |
+ |
+=over 4 |
+ |
+=item B<archive_dir> => I<archive directory> |
+ |
+Base directory of the archive. This is never used directly; however, it |
+is normally used to construct relative paths for dists_dir, incoming_dir, |
+installed_dir, pool_dir, and reject_dir. |
+ |
+WARNING: See the section documentation for important details about |
+redefining this value. |
+ |
+Default value: '/var/cache/debpool' |
+ |
+=cut |
+ |
+$Options{'archive_dir'} = '/var/cache/debpool'; |
+$OptionDefs{'archive_dir'} = 'archive_dir=s'; |
+ |
+=item B<db_dir> => I<dists directory> |
+ |
+DB directory, where the database files for each distribution are kept. |
+ |
+Default value: "$Options{'archive_dir'}/db" |
+ |
+=cut |
+ |
+$Options{'db_dir'} = "$Options{'archive_dir'}/db"; |
+$OptionDefs{'db_dir'} = 'db_dir=s'; |
+ |
+=item B<db_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for db_dir. |
+ |
+Default value: 0750 |
+ |
+=cut |
+ |
+$Options{'db_dir_mode'} = 0750; |
+$OptionDefs{'db_dir_mode'} = 'db_dir_mode=i'; |
+ |
+=item B<db_file_mode> = I<permissions (octal)> |
+ |
+Permissions for database files in db_dir. |
+ |
+Default value: 0640 |
+ |
+=cut |
+ |
+$Options{'db_file_mode'} = 0640; |
+$OptionDefs{'db_file_mode'} = 'db_file_mode=i'; |
+ |
+=item B<dists_dir> => I<dists directory> |
+ |
+Dists directory, where distribution files (F<{Packages,Sources}{,.gz}> live. |
+ |
+Default value: "$Options{'archive_dir'}/dists" |
+ |
+=cut |
+ |
+$Options{'dists_dir'} = "$Options{'archive_dir'}/dists"; |
+$OptionDefs{'dists_dir'} = 'dists_dir=s'; |
+ |
+=item B<dists_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for dists_dir and all of it's subdirectories. |
+ |
+Default value: 0755 |
+ |
+=cut |
+ |
+$Options{'dists_dir_mode'} = 0755; |
+$OptionDefs{'dists_dir_mode'} = 'dists_dir_mode=i'; |
+ |
+=item B<dists_file_mode> = I<permissions (octal)> |
+ |
+Permissions for distribution files ({Packages,Sources}{,.gz}. |
+ |
+Default value: 0644 |
+ |
+=cut |
+ |
+$Options{'dists_file_mode'} = 0644; |
+$OptionDefs{'dists_file_mode'} = 'dists_file_mode=i'; |
+ |
+=item B<incoming_dir> => I<incoming directory> |
+ |
+Incoming directory, where new packages are uploaded. |
+ |
+Default value: "$Options{'archive_dir'}/incoming"; |
+ |
+=cut |
+ |
+$Options{'incoming_dir'} = "$Options{'archive_dir'}/incoming"; |
+$OptionDefs{'incoming_dir'} = 'incoming_dir=s'; |
+ |
+=item B<incoming_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for incoming_dir. Should have the sticky bit set if you want a |
+system archive. |
+ |
+Default value: 01775 |
+ |
+=cut |
+ |
+$Options{'incoming_dir_mode'} = 01775; |
+$OptionDefs{'incoming_dir_mode'} = 'incoming_dir_mode=i'; |
+ |
+=item B<installed_dir> => I<installed directory> |
+ |
+Incoming directory, where new packages are uploaded. |
+ |
+Default value: "$Options{'archive_dir'}/installed"; |
+ |
+=cut |
+ |
+$Options{'installed_dir'} = "$Options{'archive_dir'}/installed"; |
+$OptionDefs{'installed_dir'} = 'installed_dir=s'; |
+ |
+=item B<installed_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for installed_dir. Should have the sticky bit set if you want a |
+system archive. |
+ |
+Default value: 0755 |
+ |
+=cut |
+ |
+$Options{'installed_dir_mode'} = 0755; |
+$OptionDefs{'installed_dir_mode'} = 'installed_dir_mode=i'; |
+ |
+=item B<installed_file_mode> = I<permissions (octal)> |
+ |
+Permissions for installed Changes files. |
+ |
+Default value: 0644 |
+ |
+=cut |
+ |
+$Options{'installed_file_mode'} = 0644; |
+$OptionDefs{'installed_file_mode'} = 'installed_file_mode=i'; |
+ |
+=item B<pool_dir> => I<pool directory> |
+ |
+Pool directory where all .deb files are stored after being accepted. Normally |
+this is constructed as a relative path from archive_dir. |
+ |
+Default value: "$Options{'archive_dir'}/pool" |
+ |
+=cut |
+ |
+$Options{'pool_dir'} = "$Options{'archive_dir'}/pool"; |
+$OptionDefs{'pool_dir'} = 'pool_dir=s'; |
+ |
+=item B<pool_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for pool_dir and all of it's subdirectories. |
+ |
+Default value: 0755 |
+ |
+=cut |
+ |
+$Options{'pool_dir_mode'} = 0755; |
+$OptionDefs{'pool_dir_mode'} = 'pool_dir_mode=i'; |
+ |
+=item B<pool_file_mode> = I<permissions (octal)> |
+ |
+Permissions for files installed into the pool area (orig.tar.gz, tar.gz, |
+diff.gz, dsc, deb). |
+ |
+Default value: 0644 |
+ |
+=cut |
+ |
+$Options{'pool_file_mode'} = 0644; |
+$OptionDefs{'pool_file_mode'} = 'pool_file_mode=i'; |
+ |
+=item B<reject_dir> => I<reject directory> |
+ |
+Reject directory, where rejected packages are placed. |
+ |
+Default value: "$Options{'archive_dir'}/reject" |
+ |
+=cut |
+ |
+$Options{'reject_dir'} = "$Options{'archive_dir'}/reject"; |
+$OptionDefs{'reject_dir'} = 'reject_dir=s'; |
+ |
+=item B<reject_dir_mode> = I<permissions (octal)> |
+ |
+Permissions for reject_dir. |
+ |
+Default value: 0750 |
+ |
+=cut |
+ |
+$Options{'reject_dir_mode'} = 0750; |
+$OptionDefs{'reject_dir_mode'} = 'reject_dir_mode=i'; |
+ |
+=item B<reject_file_mode> = I<permissions (octal)> |
+ |
+Permissions for rejected package files. |
+ |
+Default value: 0640 |
+ |
+=cut |
+ |
+$Options{'reject_file_mode'} = 0640; |
+$OptionDefs{'reject_file_mode'} = 'reject_file_mode=i'; |
+ |
+=item B<lock_file> => I<lockfile> |
+ |
+Location of the lockfile to use when running. |
+ |
+Default value: "$Options{'archive_dir'}/.lock" |
+ |
+=cut |
+ |
+$Options{'lock_file'} = "$Options{'archive_dir'}/.lock"; |
+$OptionDefs{'lock_file'} = 'lock_file=s'; |
+ |
+=item B<compress_dists> = I<boolean> |
+ |
+This determines whether or not compressed versions of the distribution |
+files (Packages.gz, Sources.gz) are generated. Note that enabling this |
+introduces a dependancy on gzip. |
+ |
+=cut |
+ |
+$Options{'compress_dists'} = 0; |
+$OptionDefs{'compress_dists'} = 'compress_dists!'; |
+ |
+=back |
+ |
+=cut |
+ |
+=head2 Archive configuration |
+ |
+These values control which distributions, components, and architectures the |
+archive will support. |
+ |
+=over 4 |
+ |
+=item B<dists> => I<hash of distribution names and codenames> |
+ |
+A hashref pointing to a hash with entries for all distributions we will |
+accept packages for, and what the current codename for each distribution |
+is. Note that it is acceptable for more than one distribution to point to a |
+given codename (for example, when frozen is active); however, this has some |
+strange (and non-deterministic) consequences for Release files. |
+ |
+Default value: |
+ |
+{ 'stable' => 'woody', |
+ 'testing' => 'sarge', |
+ 'unstable' => 'sid', |
+ 'experimental' => 'experimental' } |
+ |
+=cut |
+ |
+$Options{'dists'} = { |
+ 'stable' => 'woody', |
+ 'testing' => 'sarge', |
+ 'unstable' => 'sid', |
+ 'experimental' => 'experimental' |
+}; |
+$OptionDefs{'dists'} = 'dists=s%'; |
+ |
+=item B<virtual_dists> => I<hash of virtual distribution names and targets> |
+ |
+A hashref pointing to a hash with entries for all 'virtual' distributions |
+we will accept packages for, and what distribution it should be treated |
+as. It is acceptable for more than one virtual distribution to point to a |
+given target. Note that unlike 'dists' entries, symlinks pointing from the |
+virtual name to the real name will not be created, and no attempt is made |
+to use these names in reverse processes (such as Release files); however, |
+virtual distributions may target any name ("unstable") or codename ("sid") |
+which appears in the 'dists' hash. |
+ |
+Default value: |
+ |
+{ |
+} |
+ |
+Exsample value: |
+ |
+{ 'unstable-hostname' => 'unstable', |
+ 'testing-hostname' => 'sarge', |
+} |
+ |
+=cut |
+ |
+$Options{'virtual_dists'} = { |
+}; |
+ |
+=item B<sections> => I<array of section names> |
+ |
+An arrayref pointing to an array which lists all sections we will accept |
+packages for. Typically, these will be drawn from the set 'main', |
+'contrib', 'non-free', 'experimental', 'alien', and 'local' (at least on |
+the author's systems). |
+ |
+Default value: [ 'main', 'contrib', 'non-free' ] |
+ |
+=cut |
+ |
+$Options{'sections'} = [ 'main', 'contrib', 'non-free' ]; |
+$OptionDefs{'sections'} = 'sections=s@'; |
+ |
+=item B<archs> => I<array of architecture names> |
+ |
+An arrayref pointing to an array which lists all architectures we will |
+accept packages for. Note that 'source' will always be present, and 'all' |
+will be silently ignored (uploads for Arch: all will still work, but the |
+listings appear in arch-specific Packages files). |
+ |
+Default value: [ 'i386' ] |
+ |
+=back |
+ |
+=cut |
+ |
+$Options{'archs'} = [ 'i386' ]; |
+$OptionDefs{'archs'} = 'archs=s@'; |
+ |
+=head2 Release configuration |
+ |
+If all of the variables below are defined (release_origin, release_label, |
+and release_description), Release files will be generated for each |
+distribution directory. |
+ |
+Please note that enabling Release files will introduce a dependancy on the |
+packages 'libdigest-md5-perl' and 'libdigest-sha1-perl'. |
+ |
+See also: sign_release |
+ |
+=over 4 |
+ |
+=cut |
+ |
+=item B<release_origin> => I<origin tag> |
+ |
+A string to be used for the Origin tag in the Release file. |
+ |
+Default value: undef |
+ |
+=cut |
+ |
+$Options{'release_origin'} = undef; |
+$OptionDefs{'release_origin'} = 'release_origin=s'; |
+ |
+=item B<release_label> => I<label tag> |
+ |
+A string to be used for the Label tag in the Release file. |
+ |
+Default value: undef |
+ |
+=cut |
+ |
+$Options{'release_label'} = undef; |
+$OptionDefs{'release_label'} = 'release_label=s'; |
+ |
+=item B<release_description> => I<description tag> |
+ |
+A string to be used for the Description tag in the Release file. (Note that |
+this should be a single line.) |
+ |
+Default value: undef |
+ |
+=cut |
+ |
+$Options{'release_description'} = undef; |
+$OptionDefs{'release_description'} = 'release_description=s'; |
+ |
+=item B<release_noauto> = <array of NonAutomatic release names> |
+ |
+An array of release names which should be tagged with 'NonAutomatic: yes' |
+in their Release files. This tag will keep APT from ever automatically |
+selecting a package from that archive as an installation candidate. |
+ |
+Default value: [ 'experimental' ] |
+ |
+=cut |
+ |
+$Options{'release_noauto'} = [ |
+ 'experimental', |
+]; |
+ |
+=back |
+ |
+=cut |
+ |
+=head2 Signature configuration |
+ |
+Please note that enabling any of these options will cause a dependancy on |
+the 'gnupg' package. See F</usr/share/doc/debpool/README.GnuPG> for more |
+information. |
+ |
+=over 4 |
+ |
+=item B<require_sigs_debs> = I<boolean> |
+ |
+If true, packages will be rejected unless their package files (.deb) |
+are GPG-signed with a recognized key found one of the keyrings listed |
+in 'gpg_keyrings'. These can be signed with the tools in the 'debsigs' |
+package. |
+ |
+Default value: 0 (false) |
+ |
+See also: gpg_keyrings |
+ |
+=cut |
+ |
+$Options{'require_sigs_debs'} = 0; |
+$OptionDefs{'require_sigs_debs'} = 'require_sigs_debs!'; |
+ |
+=item B<require_sigs_meta> = I<boolean> |
+ |
+If true, packages will be rejected unless their meta-files (.changes and |
+.dsc) are GPG-signed with a recognized key found one of the keyrings listed |
+in 'gpg_keyrings'. These are the files normally signed by the 'debsign' |
+utility in devscripts package. |
+ |
+Default value: 0 (false) |
+ |
+See also: gpg_keyrings |
+ |
+=cut |
+ |
+$Options{'require_sigs_meta'} = 0; |
+$OptionDefs{'require_sigs_meta'} = 'require_sigs_meta!'; |
+ |
+=item B<sign_release> = I<boolean> |
+ |
+If true, generated Release files with be GPG-signed with the key specified |
+in 'gpg_sign_key'. |
+ |
+Note that this will have no effect unless 'gpg_sign_key' is also defined at |
+some point. |
+ |
+Default value: 0 (false) |
+ |
+See also: L<"Release configuration">, gpg_sign_key |
+ |
+=cut |
+ |
+$Options{'sign_release'} = 0; |
+$OptionDefs{'sign_release'} = 'sign_release!'; |
+ |
+=back |
+ |
+=cut |
+ |
+=head2 GnuPG configuration |
+ |
+These values will only be used if the use of GnuPG is triggered in some |
+fashion (such as any of the values in L<"Signature configuration"> being |
+enabled) , and thus do not (in themselves) trigger a dependancy on GnuPG. |
+Please see F</usr/share/doc/debpool/README.GnuPG> for more information. |
+ |
+=over 4 |
+ |
+=item B<gpg_bin> = I<GnuPG binary> |
+ |
+This is used to specify the GnuPG binary to run. |
+ |
+Default value: '/usr/bin/gpg' |
+ |
+=cut |
+ |
+$Options{'gpg_bin'} = '/usr/bin/gpg'; |
+$OptionDefs{'gpg_bin'} = 'gpg_bin=s'; |
+ |
+=item B<gpg_home> = I<GnuPG homedir> |
+ |
+This is used to specify the GnuPG homedir (via the --homedir option). |
+ |
+Default value: '/home/user/.gnupg' |
+ |
+=cut |
+ |
+$Options{'gpg_home'} = '/home/user/.gnupg'; |
+$OptionDefs{'gpg_home'} = 'gpg_home=s'; |
+ |
+=item B<gpg_keyrings> = I<array of keyring filenames> |
+ |
+An arrayref pointing to an array which lists all of the GPG keyrings that |
+hold keys for approved uploaders. Note that this will have no effect unless |
+at least one of 'require_sigs_debs' or 'require_sigs_meta' is enabled. |
+ |
+Default value: [ 'uploaders.gpg' ] |
+ |
+See also: require_sigs_debs, require_sigs_meta |
+ |
+=cut |
+ |
+$Options{'gpg_keyrings'} = [ 'uploaders.gpg' ]; |
+$OptionDefs{'gpg_keyrings'} = 'gpg_keyrings=s@'; |
+ |
+=item B<gpg_sign_key> = I<signature keyID> |
+ |
+A string which contains the ID of the key which we will sign Release files |
+with. Note that this will have no effect unless 'sign_release' is true. |
+ |
+Default value: undef |
+ |
+See also: sign_release |
+ |
+=cut |
+ |
+$Options{'gpg_sign_key'} = undef; |
+$OptionDefs{'gpg_sign_key'} = 'gpg_sign_key=s'; |
+ |
+=item B<gpg_passfile> = I<passphrase file> |
+ |
+This specifies the name of the file from which we read the GnuPG passphrase |
+for the key listed in gpg_sign_key. Note that it will have no effect unless |
+'sign_release' is true and 'gpg_sign_key' is defined. |
+ |
+Default value: '/home/user/.gnupg/passphrase'; |
+ |
+See also: sign_release, gpg_sign_key |
+ |
+=cut |
+ |
+$Options{'gpg_passfile'} = '/home/user/.gnupg/passphrase'; |
+$OptionDefs{'gpg_passfile'} = 'gpg_passfile=s'; |
+ |
+=back |
+ |
+=head2 Logging configuration |
+ |
+These are values which control the logging system. |
+ |
+=over 4 |
+ |
+=item B<log_file> = I<filename> |
+ |
+If this option is defined, logging output will be sent to the filename |
+specified. Note that an undefined value is considered an explicit request |
+to log nothing. |
+ |
+=cut |
+ |
+$Options{'log_file'} = '/home/user/.debpool/DebPool.log'; |
+$OptionDefs{'log_file'} = 'log_file=s'; |
+ |
+=head2 Misc. configuration |
+ |
+These are values which don't particularly fit into any of the other |
+sections. |
+ |
+=over 4 |
+ |
+=item B<daemon> = I<boolean> |
+ |
+This determines whether debpool runs as a daemon (never exiting except on |
+fatal errors, rescanning the Incoming directory periodically), or on a |
+single-run basis. True values cause debpool to run as a daemon. |
+ |
+Default value: 0 (false) |
+ |
+=cut |
+ |
+$Options{'daemon'} = 0; |
+$OptionDefs{'daemon'} = 'daemon!'; |
+ |
+=item B<sleep> = I<delay> |
+ |
+This option determines how long the daemon sleeps for, between each |
+processing run. Note that signals (such as SIGHUP, SIGINT, or SIGTERM) |
+will force the daemon to wake up before this expires, so don't worry about |
+setting it too long. |
+ |
+Default value: 300 (5 minutes) |
+ |
+=cut |
+ |
+$Options{'sleep'} = 300; |
+$OptionDefs{'sleep'} = 'sleep=i'; |
+ |
+=item B<rollback> = I<boolean> |
+ |
+This determines whether older packages in the incoming queue are allowed |
+to replace newer versions already in the archive (roll back the archive |
+version). |
+ |
+Default value: 0 (false) |
+ |
+=cut |
+ |
+$Options{'rollback'} = 0; |
+$OptionDefs{'rollback'} = 'rollback!'; |
+ |
+=item B<rebuild-files> = I<boolean> |
+ |
+This option can be set in configfiles, but is more commonly used from the |
+commandline; if set, it forces all of the distribution files (Packages and |
+Sources) to be rebuilt, whether or not they need it. This should almost |
+never be used in conjunction with the daemon option. |
+ |
+Default value: 0 (false) |
+ |
+=cut |
+ |
+$Options{'rebuild-files'} = 0; |
+$OptionDefs{'rebuild-files'} = 'rebuild-files!'; |
+ |
+=item B<rebuild-dbs> = I<boolean> |
+ |
+This option should not be set in configfiles, only used from the |
+commandline; if set, it forces all of the metadata files to be rebuilt from |
+scratch. It should, of course, also not be used with the daemon option. |
+ |
+WARNING: This feature is not yet implemented, and will (silently) fail to |
+do anything, at this time. It will be implemented in a future version. |
+ |
+Default value: 0 (false) |
+ |
+=cut |
+ |
+$Options{'rebuild-dbs'} = 0; |
+$OptionDefs{'rebuild-dbs'} = 'rebuild-dbs!'; |
+ |
+=item B<rebuild-all> = I<boolean> |
+ |
+This option should not be set in configfiles, only used from the |
+commandline; if set, it is equivalent to turning on all other rebuild |
+options (currently --rebuild-files and --rebuild-dbs). |
+ |
+WARNING: This feature depends on rebuild-dbs, which is not yet implemented; |
+only the --rebuild-files section will be triggered. |
+ |
+Default value: 0 (false) |
+ |
+=cut |
+ |
+$Options{'rebuild-all'} = 0; |
+$OptionDefs{'rebuild-all'} = 'rebuild-all!'; |
+ |
+=item B<config> = I<configfile> |
+ |
+This is a special option that should not be put into configfiles; it is |
+intended only for command-line use. It may be issued multiple times; each |
+time it is used, it will add the named config file to the list which |
+DebPool will load (later config files override earlier ones, in case of any |
+conflicts). |
+ |
+Default value: N/A |
+ |
+=back |
+ |
+=cut |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+=head1 CAVEATS |
+ |
+Command line options will override all Config.pm declarations. |
+ |
+=cut |
+ |
+=head1 SEE ALSO |
+ |
+L<debpool(1)> |
+ |
+=cut |
+ |
+=head1 AUTHOR |
+ |
+Joel Baker <fenton@debian.org> |
+ |
+=cut |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/DB.pm |
=================================================================== |
--- trunk/share/DebPool/DB.pm (nonexistent) |
+++ trunk/share/DebPool/DB.pm (revision 3) |
@@ -0,0 +1,262 @@ |
+package DebPool::DB; |
+ |
+### |
+# |
+# DebPool::DB - Module for managing data hashes via tied NDBM files |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: DB.pm 62 2005-02-23 18:02:38Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+# This module mostly wraps calls to tied NDBM hashes, so we need these. |
+ |
+use Fcntl; |
+use NDBM_File; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ %ComponentDB |
+ &Open_Databases |
+ &Close_Databases |
+ &Get_Version |
+ &Set_Versions |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Open_Databases &Close_Databases &Get_Version |
+ &Set_Versions)], |
+ 'vars' => [qw(%ComponentDB)], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# I'd love to be able to do this as a hash of hashes of hashrefs, but the |
+# database layer can't handle it. So we have multiple DBs. |
+ |
+# VersionDB - hash of tied hashes, keyed on Distribution (then Source |
+# package). Keeps track of all versions. Prior to 0.2.2, the value pointed |
+# to was a scalar representing the version of the source package; as of |
+# 0.2.2 and later, updated records are hashrefs pointing to hashes that |
+# have package -> version mappings, with 'source' being the key for source |
+# package version. |
+ |
+our(%VersionDB); |
+ |
+# ComponentDB - hash of tied hashes, keyed on Distribution (then Source |
+# package). Stores the component data for the given package. |
+ |
+our(%ComponentDB); |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Open_Databases() |
+# |
+# Open all tied NDBM hashes for each real distribution. Returns 0 in the |
+# case of errors opening hashes, 1 otherwise. |
+ |
+sub Open_Databases { |
+ use DebPool::Config qw(:vars); |
+ |
+ my($db_dir) = $Options{'db_dir'}; |
+ my($db_file_mode) = $Options{'db_file_mode'}; |
+ my($dist); |
+ |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ my(%tiedhash); |
+ my($tie_result) = tie(%tiedhash, 'NDBM_File', |
+ "$db_dir/${dist}_version", |
+ O_RDWR|O_CREAT, $db_file_mode); |
+ if (!defined($tie_result)) { |
+ return 0; |
+ }; |
+ |
+ $VersionDB{$dist} = \%tiedhash; |
+ } |
+ |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ my(%tiedhash); |
+ my($tie_result) = tie(%tiedhash, 'NDBM_File', |
+ "$db_dir/${dist}_component", |
+ O_RDWR|O_CREAT, $db_file_mode); |
+ if (!defined($tie_result)) { |
+ return 0; |
+ }; |
+ |
+ $ComponentDB{$dist} = \%tiedhash; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Close_Databases() |
+# |
+# Closes all tied NDBM hashes. |
+# |
+# NOTE: Untie doesn't return anything (?), so we can't really trap errors. |
+ |
+sub Close_Databases { |
+ my($dist); |
+ |
+ foreach $dist (keys(%VersionDB)) { |
+ untie(%{$VersionDB{$dist}}); |
+ } |
+ |
+ foreach $dist (keys(%ComponentDB)) { |
+ untie(%{$ComponentDB{$dist}}); |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Get_Version($dist, $source, $package) |
+# |
+# Retrieves the version of $package (from source package $source) in |
+# distribution $dist. The package name 'source' retrieves the source |
+# package name, or undef if no information is available. |
+ |
+sub Get_Version { |
+ my($dist, $source, $package) = @_; |
+ |
+ my($temp) = $VersionDB{$dist}->{$source}; |
+ if (!defined($temp)) { return undef; } |
+ |
+ # Versions prior to 0.2.2 had only one entry, which is the source |
+ # version; since this is the same as the binary version on the vast |
+ # majority of packages, fake an answer. This works because hash entries |
+ # are guaranteed to be non-empty. |
+ |
+ if ($temp !~ m/\|/) { |
+ return $temp; |
+ } |
+ |
+ if ('meta' eq $package) { |
+ $temp =~ s/\|.*//; |
+ return $temp; |
+ } elsif ('source' eq $package) { |
+ return $VersionDB{$dist}->{"source_${source}"}; |
+ } else { |
+ return $VersionDB{$dist}->{"binary_${source}_${package}"}; |
+ } |
+} |
+ |
+# Set_Versions($dist, $source, $file_arrayref |
+ |
+sub Set_Versions { |
+ my($dist, $source, $meta_version, $file_arrayref) = @_; |
+ |
+ my($oldbinlist) = $VersionDB{$dist}->{$source}; |
+ if (defined($oldbinlist) && ($oldbinlist =~ m/\|/)) { # 0.2.2 or later |
+ $oldbinlist =~ s/.*\|//; # Strip meta version |
+ my(@oldbins) = split(/,/,$oldbinlist); |
+ |
+ my($oldbin); |
+ foreach $oldbin (@oldbins) { |
+ $VersionDB{$dist}->{"binary_${source}_${oldbin}"} = undef; |
+ } |
+ |
+ $VersionDB{$dist}->{"source_${source}"} = undef; |
+ $VersionDB{$dist}->{"${source}"} = undef; |
+ } |
+ |
+ # Walk through each file looking for version data. Note that only the |
+ # .dsc file is guaranteed to be the same for source uploads (it can be |
+ # orig.tar.gz or tar.gz, and diff.gz need not exist), and .deb files |
+ # have binary versions, so that's all we look for. |
+ # |
+ # FIXME: Do udeb files have different versions from deb files? |
+ |
+ my(@files) = @{$file_arrayref}; |
+ my(@entries) = (); |
+ |
+ my($hashref); |
+ foreach $hashref (@files) { |
+ my($filename) = $hashref->{'Filename'}; |
+ |
+ if ($filename =~ m/^([^_]+)_([^_]+)_.+\.deb/) { |
+ my($package) = $1; |
+ my($version) = $2; |
+ |
+ $VersionDB{$dist}->{"binary_${source}_${package}"} = $version; |
+ push(@entries, $package); |
+ } elsif ($filename =~ m/^[^_]+_([^_]+)\.dsc/) { |
+ my($version) = $1; |
+ |
+ $VersionDB{$dist}->{"source_${source}"} = $version; |
+ push(@entries, 'source'); |
+ } # else skip |
+ } |
+ |
+ $VersionDB{$dist}->{$source} = "${meta_version}|" . join(',', @entries); |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Logging.pm |
=================================================================== |
--- trunk/share/DebPool/Logging.pm (nonexistent) |
+++ trunk/share/DebPool/Logging.pm (revision 3) |
@@ -0,0 +1,172 @@ |
+package DebPool::Logging; |
+ |
+### |
+# |
+# DebPool::Logging - Module to handle logging messages |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Logging.pm 31 2005-01-19 17:32:38Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+# For strftime() |
+ |
+use POSIX; |
+ |
+# We need to pull config option information |
+ |
+use DebPool::Config qw(:vars); |
+use DebPool::DB qw(:functions); # DB::Close_Databases |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Log_Message |
+ &LOG_AUDIT |
+ &LOG_CONFIG |
+ &LOG_DEBUG |
+ &LOG_ERROR |
+ &LOG_FATAL |
+ &LOG_GENERAL |
+ &LOG_GPG |
+ &LOG_INFO |
+ &LOG_INSTALL |
+ &LOG_PARSE |
+ &LOG_REJECT |
+ &LOG_WARNING |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Log_Message)], |
+ 'vars' => [qw()], |
+ 'facility' => [qw(&LOG_AUDIT &LOG_CONFIG &LOG_GENERAL &LOG_GPG |
+ &LOG_INSTALL &LOG_PARSE &LOG_REJECT)], |
+ 'level' => [qw(&LOG_DEBUG &LOG_INFO &LOG_WARNING &LOG_ERROR |
+ &LOG_FATAL)], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# None |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions - facility |
+ |
+sub LOG_AUDIT() { 'AUDIT' } |
+sub LOG_CONFIG() { 'CONFIG' } |
+sub LOG_GENERAL() { 'GENERAL' } |
+sub LOG_GPG() { 'GPG' } |
+sub LOG_INSTALL() { 'INSTALL' } |
+sub LOG_REJECT() { 'REJECT' } |
+sub LOG_PARSE() { 'PARSE' } |
+ |
+### Constant functions - level |
+ |
+sub LOG_DEBUG() { 'DEBUG' } |
+sub LOG_INFO() { 'INFO' } |
+sub LOG_WARNING() { 'WARNING' } |
+sub LOG_ERROR() { 'ERROR' } |
+sub LOG_FATAL() { 'FATAL' } |
+ |
+### Meaningful functions |
+ |
+# Log_Message($message, FACILITY, LEVEL) |
+# |
+# Log a message with text $message using FACILITY and LEVEL, via the current |
+# configured log method. |
+ |
+# FIXME - this is a really crude logging setup. We should probably support |
+# a variety of things, like logging to processes, syslogging, not doing an |
+# open/close for each message, maybe email logging with batched messages. |
+# |
+# However, this is an early version, so it will suffice for now. |
+ |
+sub Log_Message { |
+ my($msg, $facility, $level) = @_; |
+ |
+ # First, do we have anywhere to log? We assume that 'undef' is an |
+ # explicit request to not log, since it isn't a default value. |
+ |
+ if (!defined($Options{'log_file'})) { |
+ return; |
+ } |
+ |
+ # If we can't log to it, die with a message (on the off chance that we're |
+ # not in daemon mode, and the user will see it). |
+ |
+ if (!open(LOG, ">>$Options{'log_file'}")) { |
+ Close_Databases(); # If they were open |
+ unlink($Options{'lock_file'}); # In case we had one |
+ |
+ die "Couldn't write to log file '$Options{'log_file'}'."; |
+ } |
+ |
+ print LOG strftime("%Y-%m-%d %H:%M:%S", localtime()); |
+ print LOG " [$facility/$level] $msg\n"; |
+ close(LOG); |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Gzip.pm |
=================================================================== |
--- trunk/share/DebPool/Gzip.pm (nonexistent) |
+++ trunk/share/DebPool/Gzip.pm (revision 3) |
@@ -0,0 +1,164 @@ |
+package DebPool::Gzip; |
+ |
+### |
+# |
+# DebPool::Gzip - Module for handling Gzip interactions |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Gzip.pm 27 2004-11-07 03:06:59Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+use POSIX; # WEXITSTATUS |
+use File::Temp qw(tempfile); |
+ |
+# Needed for open2() |
+ |
+use Fcntl; |
+use IPC::Open2; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Gzip_File |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Gzip_File)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Gzip_File($file) |
+# |
+# Generates a gzipped version of $file, and returns the filename. Returns |
+# undef (and sets $Error) on failure. |
+ |
+sub Gzip_File { |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($file) = @_; |
+ |
+ # Open a secure tempfile to write the compressed data into |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ # Open the source file so that we have it available. |
+ |
+ if (!open(SOURCE, '<', $file)) { |
+ $Error = "Couldn't open source file '$file': $!"; |
+ return undef; |
+ } |
+ |
+ # We are go for main engine start |
+ |
+ my(@args) = ('--best', '--force', '--stdout'); |
+ |
+ my($gzip_pid) = open2(*GZIP_IN, *GZIP_OUT, '/bin/gzip', @args); |
+ |
+ my($child_pid); |
+ if ($child_pid = fork) { # In the parent |
+ # Send all the data to Gzip; |
+ |
+ close(GZIP_IN); |
+ close($tmpfile_handle); |
+ |
+ print GZIP_OUT <SOURCE>; |
+ close(GZIP_OUT); |
+ close(SOURCE); |
+ |
+ waitpid($child_pid, 0); |
+ } else { # In the child - we hope |
+ if (!defined($child_pid)) { |
+ die "Couldn't fork: $!\n"; |
+ } |
+ |
+ # Read back the results, and print them into the tempfile. |
+ |
+ close(GZIP_OUT); |
+ close(SOURCE); |
+ |
+ print $tmpfile_handle <GZIP_IN>; |
+ close(GZIP_IN); |
+ close($tmpfile_handle); |
+ |
+ exit(0); |
+ } |
+ |
+ # And we're done |
+ |
+ return $tmpfile_name; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Signal.pm |
=================================================================== |
--- trunk/share/DebPool/Signal.pm (nonexistent) |
+++ trunk/share/DebPool/Signal.pm (revision 3) |
@@ -0,0 +1,144 @@ |
+package DebPool::Signal; |
+ |
+### |
+# |
+# DebPool::DB - Module for handling inter-process signals |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Signal.pm 27 2004-11-07 03:06:59Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+# We do logging, so we need this. |
+ |
+use DebPool::Logging qw(:functions :facility :level); |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ $Signal_Caught |
+ %ComponentDB |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw()], |
+ 'vars' => [qw($Signal_Caught)], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# Boolean value indicating whether we have caught one of the signals that |
+# normally trigger clean termination (SIGHUP, SIGINT, SIGPIPE, SIGTERM). |
+ |
+our($Signal_Caught) = 0; |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# None |
+ |
+### Special |
+ |
+# The purpose of this module is to handle signals usefully; therefore, we |
+# set up a basic term-signal handler that catches the 'ordinary termination |
+# requested' class of signals, and bind it via sigtrap. |
+ |
+sub Handle_SIGtermrequest { |
+ my($signal) = shift(@_); |
+ |
+ $Signal_Caught = 1; |
+ Log_Message("Caught signal " . $signal, LOG_GENERAL, LOG_INFO); |
+} |
+ |
+sub Handle_SIGHUP { |
+ Handle_SIGtermrequest('SIGHUP'); |
+} |
+ |
+use sigtrap qw(handler Handle_SIGHUP HUP); |
+ |
+sub Handle_SIGINT { |
+ Handle_SIGtermrequest('SIGINT'); |
+} |
+ |
+use sigtrap qw(handler Handle_SIGINT INT); |
+ |
+sub Handle_SIGPIPE { |
+ Handle_SIGtermrequest('SIGPIPE'); |
+} |
+ |
+use sigtrap qw(handler Handle_SIGPIPE PIPE); |
+ |
+sub Handle_SIGTERM { |
+ Handle_SIGtermrequest('SIGTERM'); |
+} |
+ |
+use sigtrap qw(handler Handle_SIGTERM TERM); |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Util.pm |
=================================================================== |
--- trunk/share/DebPool/Util.pm (nonexistent) |
+++ trunk/share/DebPool/Util.pm (revision 3) |
@@ -0,0 +1,129 @@ |
+package DebPool::Util; |
+ |
+### |
+# |
+# DebPool::Util - Module to contain various utility routines |
+# |
+# Copyright 2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Util.pm 27 2004-11-07 03:06:59Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+use File::Copy; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Move_File |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Move_File)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# None |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Move_File($orig, $new, $mode) |
+# |
+# Move an file from $orig to $new by copying, and set the file mode |
+# of the new file according to the variables given. |
+# |
+# Returns 1 if successful, 0 if not (and sets $Error) |
+ |
+sub Move_File { |
+ my($orig) = shift(@_); |
+ my($new) = shift(@_); |
+ my($mode) = shift(@_); |
+ |
+ if (!copy($orig, $new)) { |
+ $Error = $!; |
+ return 0; |
+ } |
+ |
+ if (!chmod($mode, $new)) { |
+ $Error = $!; |
+ return 0; |
+ } |
+ |
+ if (!unlink($orig)) { |
+ $Error = $!; |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Packages.pm |
=================================================================== |
--- trunk/share/DebPool/Packages.pm (nonexistent) |
+++ trunk/share/DebPool/Packages.pm (revision 3) |
@@ -0,0 +1,1253 @@ |
+package DebPool::Packages; |
+ |
+### |
+# |
+# DebPool::Packages - Module for handling package metadata |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Packages.pm 70 2006-06-26 20:44:57Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+use POSIX; # WEXITSTATUS |
+use File::Temp qw(tempfile); |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Allow_Version |
+ &Audit_Package |
+ &Generate_List |
+ &Generate_Package |
+ &Generate_Source |
+ &Guess_Section |
+ &Install_List |
+ &Install_Package |
+ &Parse_Changes |
+ &Parse_DSC |
+ &Reject_Package |
+ &Verify_MD5 |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Allow_Version &Audit_Package &Generate_List |
+ &Generate_Package &Generate_Source &Guess_Section |
+ &Install_List &Install_Package &Parse_Changes |
+ &Parse_DSC &Reject_Package &Verify_MD5)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# None |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+# Fields (other than package relationships) from dpkg --info that we |
+# actually care about in some fashion. |
+ |
+my(@Info_Fields) = ( |
+# 'Package', |
+ 'Priority', |
+ 'Section', |
+ 'Installed-Size', |
+# 'Maintainer', |
+ 'Architecture', |
+# 'Version', |
+ 'Essential', |
+); |
+ |
+# Package relationship fieldnames. |
+ |
+my(@Relationship_Fields) = ( |
+ 'Pre-Depends', |
+ 'Depends', |
+ 'Provides', |
+ 'Conflicts', |
+ 'Recommends', |
+ 'Suggests', |
+ 'Enhances', |
+ 'Replaces', |
+); |
+ |
+# Normal fields potentially found in .changes files |
+ |
+my(%Changes_Fields) = ( |
+ 'Format' => 'string', |
+ 'Date' => 'string', |
+ 'Source' => 'string', |
+ 'Binary' => 'space_array', |
+ 'Architecture' => 'space_array', |
+ 'Version' => 'string', |
+ 'Distribution' => 'space_array', |
+ 'Urgency' => 'string', |
+ 'Maintainer' => 'string', |
+ 'Changed-By' => 'string', |
+ 'Closes' => 'space_array', |
+); |
+ |
+# Normal fields potentially found in .dsc files |
+ |
+my(%DSC_Fields) = ( |
+ 'Format' => 'string', |
+ 'Source' => 'string', |
+ 'Version' => 'string', |
+ 'Binary' => 'comma_array', |
+ 'Maintainer' => 'string', |
+ 'Architecture' => 'space_array', |
+ 'Standards-Version' => 'string', |
+ 'Build-Depends' => 'comma_array', |
+ 'Build-Depends-Indep' => 'comma_array', |
+); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Allow_Version($package, $version, $distribution) |
+# |
+# Decide, based on version comparison and config options, whether $version |
+# is an acceptable version for $package in $distribution. Returns 1 if the |
+# version is acceptable, 0 if it is not, and undef (and sets $Error) in the |
+# case of an error. |
+ |
+sub Allow_Version { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::DB qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($package, $version, $distribution) = @_; |
+ my($old_version) = Get_Version($distribution, $package, 'meta'); |
+ |
+ # If we permit rollback, any version is valid. |
+ |
+ if ($Options{'rollback'}) { |
+ return 1; |
+ } |
+ |
+ # If we don't have an old version, anything is acceptable. |
+ |
+ if (!defined($old_version)) { |
+ return 1; |
+ } |
+ |
+ my($dpkg_bin) = '/usr/bin/dpkg'; |
+ my(@args) = ('--compare-versions', $version, 'gt', $old_version); |
+ |
+ my($sysret) = WEXITSTATUS(system($dpkg_bin, @args)); |
+ |
+ if (0 != $sysret) { # DPKG says no go. |
+ my($msg) = "Version comparison for '$package': proposed version for "; |
+ $msg .= "$distribution ($version) is not greater than current "; |
+ $msg .= "version ($old_version)"; |
+ Log_Message($msg, LOG_GENERAL, LOG_DEBUG); |
+ |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Parse_Changes($changes_filename) |
+# |
+# Parses the changes file found at $changes_filename (which should be a |
+# fully qualified path and filename), and returns a hashref pointing to a |
+# Changes hash. Returns undef in the case of a failure (and sets $Error). |
+ |
+# Changes Hash format: |
+# { |
+# 'Architecture' => \@Architectures |
+# 'Binary' => \@Binaries |
+# 'Changed-By' => Changed-By |
+# 'Changes' => \@Changes lines |
+# 'Closes' => \@Bugs |
+# 'Description' => Description |
+# 'Files' => \@\%File Hashes |
+# 'Date' => RFC 822 timestamp |
+# 'Distribution' => \@Distributions |
+# 'Maintainer' => Maintainer |
+# 'Source' => Source |
+# 'Urgency' => Urgency |
+# 'Version' => Version |
+# } |
+ |
+# File Hash format: |
+# { |
+# 'Filename' => Filename (leaf node only) |
+# 'MD5Sum' => File MD5Sum |
+# 'Priority' => Requested archive priority |
+# 'Section' => Requested archive section |
+# 'Size' => File size (in bytes) |
+# } |
+ |
+sub Parse_Changes { |
+ use DebPool::GnuPG qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($file) = @_; |
+ my(%result); |
+ |
+ # Read in the entire Changes file, stripping GPG encoding if we find |
+ # it. It should be small, this is fine. |
+ |
+ if (!open(CHANGES, '<', $file)) { |
+ $Error = "Couldn't open changes file '$file': $!"; |
+ return undef; |
+ } |
+ |
+ my(@changes) = <CHANGES>; |
+ chomp(@changes); |
+ @changes = Strip_GPG(@changes); |
+ close(CHANGES); |
+ |
+ # Go through each of the primary fields, stuffing it into the result |
+ # hash if we find it. |
+ |
+ my($field); |
+ foreach $field (keys(%Changes_Fields)) { |
+ my(@lines) = grep(/^${field}:\s+/, @changes); |
+ if (-1 == $#lines) { # No match |
+ next; |
+ } elsif (0 < $#lines) { # Multiple matches |
+ Log_Message("Duplicate entries for field '$field'", |
+ LOG_PARSE, LOG_WARNING); |
+ } |
+ |
+ $lines[0] =~ s/^${field}:\s+//; |
+ |
+ if ('string' eq $Changes_Fields{$field}) { |
+ $result{$field} = $lines[0]; |
+ } elsif ('space_array' eq $Changes_Fields{$field}) { |
+ my(@array) = split(/\s+/, $lines[0]); |
+ $result{$field} = \@array; |
+ } elsif ('comma_array' eq $Changes_Fields{$field}) { |
+ my(@array) = split(/\s+,\s+/, $lines[0]); |
+ $result{$field} = \@array; |
+ } |
+ } |
+ |
+ # Now that we should have it, check to make sure we have a Format |
+ # header, and that it's format 1.7 (the only thing we grok). |
+ |
+ if (!defined($result{'Format'})) { |
+ Log_Message("No Format header found in changes file '$file'", |
+ LOG_PARSE, LOG_ERROR); |
+ $Error = 'No Format header found'; |
+ return undef; |
+ } elsif ('1.7' ne $result{'Format'}) { |
+ Log_Message("Unrecognized Format version '$result{'Format'}'", |
+ LOG_PARSE, LOG_ERROR); |
+ $Error = 'Unrecognized Format version'; |
+ return undef; |
+ } |
+ |
+ # Special case: Description. One-line entry, immediately after a line |
+ # with '^Description:'. |
+ |
+ my($count); |
+ |
+ for $count (0..$#changes) { |
+ if ($changes[$count] =~ m/^Description:/) { |
+ $result{'Description'} = $changes[$count+1]; |
+ } |
+ } |
+ |
+ # Special case: Changes. Multi-line entry, starts one line after |
+ # '^Changes:', goes until we hit the Files header. |
+ |
+ my($found) = 0; |
+ my(@changelines); |
+ |
+ for $count (0..$#changes) { |
+ if ($found) { |
+ if ($changes[$count] =~ m/^Files:/) { |
+ $found = 0; |
+ } else { |
+ push(@changelines, $changes[$count]); |
+ } |
+ } else { |
+ if ($changes[$count] =~ m/^Changes:/) { |
+ $found = 1; |
+ } |
+ } |
+ } |
+ |
+ $result{'Changes'} = \@changelines; |
+ |
+ # The Files section is a special case. It starts on the line after the |
+ # 'Files:' header, and goes until we hit a blank line, or the end of |
+ # the data. |
+ |
+ my(@files); |
+ |
+ for $count (0..$#changes) { |
+ if ($found) { |
+ if ($changes[$count] =~ m/^\s*$/) { # Blank line |
+ $found = 0; # No longer in Files |
+ } elsif ($changes[$count] =~ m/\s*([[:xdigit:]]+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)/) { |
+ my($md5, $size, $sec, $pri, $file) = ($1, $2, $3, $4, $5); |
+ push(@files, { |
+ 'Filename' => $file, |
+ 'MD5Sum' => $md5, |
+ 'Priority' => $pri, |
+ 'Section' => $sec, |
+ 'Size' => $size, |
+ }); |
+ } else { # What's this doing here? |
+ my($msg) = 'Unrecognized data in Files section of changes file'; |
+ $msg .= " '$file'"; |
+ Log_Message($msg, LOG_PARSE, LOG_WARNING); |
+ } |
+ } else { |
+ if ($changes[$count] =~ m/^Files:/) { |
+ $found = 1; |
+ } |
+ } |
+ } |
+ |
+ $result{'Files'} = \@files; |
+ |
+ return \%result; |
+} |
+ |
+# Parse_DSC($dsc_filename) |
+# |
+# Parses the dsc file found at $dsc_filename (which should be a fully |
+# qualified path and filename), and returns a hashref pointing to a DSC |
+# hash. Returns undef in the case of a failure (and sets $Error). |
+ |
+# DSC Hash format: |
+# { |
+# 'Format' => Format |
+# 'Source' => Source |
+# 'Binary' => \@Binaries |
+# 'Maintainer' => Maintainer |
+# 'Architecture' => \@Architectures |
+# 'Standards-Version' => Standards-Version |
+# 'Build-Depends' => Build-Depends |
+# 'Build-Depends-Indep' => Build-Depends-Indep |
+# 'Files' => \@\%Filehash |
+# } |
+ |
+# File Hash format: |
+# { |
+# 'Filename' => Filename (leaf node only) |
+# 'MD5Sum' => File MD5Sum |
+# 'Size' => File size (in bytes) |
+# } |
+ |
+sub Parse_DSC { |
+ use DebPool::GnuPG qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($file) = @_; |
+ my(%result); |
+ |
+ # Read in the entire DSC file, stripping GPG encoding if we find it. It |
+ # should be small, this is fine. |
+ |
+ if (!open(DSC, '<', $file)) { |
+ $Error = "Couldn't open dsc file '$file': $!"; |
+ return undef; |
+ } |
+ |
+ my(@dsc) = <DSC>; |
+ chomp(@dsc); |
+ @dsc = Strip_GPG(@dsc); |
+ close(DSC); |
+ |
+ # Go through each of the primary fields, stuffing it into the result |
+ # hash if we find it. |
+ |
+ my($field); |
+ foreach $field (keys(%DSC_Fields)) { |
+ my(@lines) = grep(/^${field}:\s+/, @dsc); |
+ if (-1 == $#lines) { # No match |
+ next; |
+ } elsif (0 < $#lines) { # Multiple matches |
+ Log_Message("Duplicate entries for field '$field'", |
+ LOG_PARSE, LOG_WARNING); |
+ } |
+ |
+ $lines[0] =~ s/^${field}:\s+//; |
+ |
+ if ('string' eq $DSC_Fields{$field}) { |
+ $result{$field} = $lines[0]; |
+ } elsif ('space_array' eq $DSC_Fields{$field}) { |
+ my(@array) = split(/\s+/, $lines[0]); |
+ $result{$field} = \@array; |
+ } elsif ('comma_array' eq $DSC_Fields{$field}) { |
+ my(@array) = split(/\s+,\s+/, $lines[0]); |
+ $result{$field} = \@array; |
+ } |
+ } |
+ |
+ # Now that we should have it, check to make sure we have a Format |
+ # header, and that it's format 1.0 (the only thing we grok). |
+ |
+ if (!defined($result{'Format'})) { |
+ Log_Message("No Format header found in dsc file '$file'", |
+ LOG_PARSE, LOG_ERROR); |
+ $Error = 'No Format header found'; |
+ return undef; |
+ } elsif ('1.0' ne $result{'Format'}) { |
+ Log_Message("Unrecognized Format version '$result{'Format'}'", |
+ LOG_PARSE, LOG_ERROR); |
+ $Error = 'Unrecognized Format version'; |
+ return undef; |
+ } |
+ |
+ # The Files section is a special case. It starts on the line after the |
+ # 'Files:' header, and goes until we hit a blank line, or the end of |
+ # the data. |
+ |
+ # In fact, it's even more special than that; it includes, first, an entry |
+ # for the DSC file itself... |
+ |
+ my($count); |
+ my($found) = 0; |
+ my(@files); |
+ |
+ my(@temp) = split(/\//, $file); |
+ my($dsc_leaf) = pop(@temp); |
+ |
+ my($cmd_result) = `/usr/bin/md5sum $file`; |
+ $cmd_result =~ m/^([[:xdigit:]]+)\s+/; |
+ my($dsc_md5) = $1; |
+ |
+ my(@stat) = stat($file); |
+ if (!@stat) { |
+ $Error = "Couldn't stat DSC file '$file'"; |
+ return undef; |
+ } |
+ my($dsc_size) = $stat[7]; |
+ |
+ push(@files, { |
+ 'Filename' => $dsc_leaf, |
+ 'MD5Sum' => $dsc_md5, |
+ 'Size' => $dsc_size, |
+ }); |
+ |
+ for $count (0..$#dsc) { |
+ if ($found) { |
+ if ($dsc[$count] =~ m/^\s*$/) { # Blank line |
+ $found = 0; # No longer in Files |
+ } elsif ($dsc[$count] =~ m/\s*([[:xdigit:]]+)\s+(\d+)\s+(\S+)/) { |
+ my($md5, $size, $file) = ($1, $2, $3); |
+ push(@files, { |
+ 'Filename' => $file, |
+ 'MD5Sum' => $md5, |
+ 'Size' => $size, |
+ }); |
+ } else { # What's this doing here? |
+ my($msg) = 'Unrecognized data in Files section of dsc file'; |
+ $msg .= " '$file'"; |
+ Log_Message($msg, LOG_PARSE, LOG_WARNING); |
+ } |
+ } else { |
+ if ($dsc[$count] =~ m/^Files:/) { |
+ $found = 1; |
+ } |
+ } |
+ } |
+ |
+ $result{'Files'} = \@files; |
+ |
+ return \%result; |
+} |
+ |
+# Generate_List($distribution, $section, $arch) |
+# |
+# Generates a Packages (or Sources) file for the given distribution, |
+# section, and architecture (with 'source' being a special value for |
+# Sources). Returns the filename of the generated file on success, or undef |
+# (and sets $Error) on failure. Note that requests for an 'all' list are |
+# ignored - however, every non-source arch gets 'all' files. |
+ |
+sub Generate_List { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::DB qw(:functions :vars); |
+ use DebPool::Dirs qw(:functions); |
+ |
+ my($distribution, $section, $arch) = @_; |
+ |
+ my(%packages); |
+ |
+ if ('all' eq $arch) { |
+ $Error = "No point in generating Packages file for binary-all"; |
+ return undef; |
+ } |
+ |
+ my(@sources) = grep($ComponentDB{$distribution}->{$_} eq $section, |
+ keys(%{$ComponentDB{$distribution}})); |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ my($source); |
+ |
+ # Dump the data from pool/*/*/pkg_ver.{package,source} into the list. |
+ |
+ # FIXME: This needs to be refactored. Needs it pretty badly, in fact. |
+ |
+ if ('source' eq $arch) { |
+ foreach $source (@sources) { |
+ my($pool) = join('/', |
+ ($Options{'pool_dir'}, PoolDir($source, $section), $source)); |
+ my($version) = Get_Version($distribution, $source, 'meta'); |
+ my($target) = "$pool/${source}_" . Strip_Epoch($version); |
+ $target .= '.source'; |
+ |
+ # Source files aren't always present. |
+ next if (!open(SRC, '<', "$target")); |
+ |
+ print $tmpfile_handle <SRC>; |
+ close(SRC); |
+ } |
+ } else { |
+ foreach $source (@sources) { |
+ my($pool) = join('/', |
+ ($Options{'pool_dir'}, PoolDir($source, $section), $source)); |
+ my($version) = Get_Version($distribution, $source, 'meta'); |
+ my($target) = "$pool/${source}_" . Strip_Epoch($version); |
+ $target .= '.package'; |
+ |
+ if (!open(PKG, '<', "$target")) { |
+ my($msg) = "Skipping package entry for all packages from "; |
+ $msg .= "${source}: couldn't open '$target' for reading: $!"; |
+ |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ next; |
+ } |
+ |
+ # Playing around with the record separator ($/) to make this |
+ # easier. |
+ |
+ my($backup_RS) = $/; |
+ $/ = ""; |
+ |
+ my(@entries) = <PKG>; |
+ close(PKG); |
+ |
+ $/ = $backup_RS; |
+ |
+ # Pare it down to the relevant entries, and print those out. |
+ |
+ @entries = grep(/\nArchitecture: ($arch|all)\n/, @entries); |
+ print $tmpfile_handle @entries; |
+ } |
+ } |
+ |
+ close($tmpfile_handle); |
+ |
+ return $tmpfile_name; |
+} |
+ |
+# Install_Package($changes, $Changes_hashref, $DSC, $DSC_hashref, \@distributions) |
+# |
+# Install all of the package files for $Changes_hashref (which should |
+# be a Parse_Changes result hash) into the pool directory, and install |
+# the file in $changes to the installed directory. Also generates (and |
+# installes) .package and .source meta-data files. It also updates the |
+# Version database for the listed distributions. Returns 1 if successful, 0 |
+# if not (and sets $Error). |
+ |
+sub Install_Package { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Dirs qw(:functions); |
+ use DebPool::DB qw(:functions :vars); |
+ use DebPool::Util qw(:functions); |
+ |
+ my($changes, $chg_hashref, $dsc, $dsc_hashref, $distributions) = @_; |
+ |
+ my($incoming_dir) = $Options{'incoming_dir'}; |
+ my($installed_dir) = $Options{'installed_dir'}; |
+ my($pool_dir) = $Options{'pool_dir'}; |
+ |
+ my($pkg_name) = $chg_hashref->{'Source'}; |
+ my($pkg_ver) = $chg_hashref->{'Version'}; |
+ |
+ my($guess_section) = Guess_Section($chg_hashref); |
+ my($pkg_dir) = join('/', |
+ ($pool_dir, PoolDir($pkg_name, $guess_section), $pkg_name)); |
+ |
+ # Make sure the package directory exists (and is a directory!) |
+ |
+ if (! -e $pkg_dir) { |
+ if (!mkdir($pkg_dir)) { |
+ $Error = "Failed to mkdir '$pkg_dir': $!"; |
+ return 0; |
+ } |
+ if (!chmod($Options{'pool_dir_mode'}, $pkg_dir)) { |
+ $Error = "Failed to chmod '$pkg_dir': $!"; |
+ return 0; |
+ } |
+ } elsif (! -d $pkg_dir) { |
+ $Error = "Target '$pkg_dir' is not a directory."; |
+ return 0; |
+ } |
+ |
+ # Walk the File Hash, trying to install each listed file into the |
+ # pool directory. |
+ |
+ my($filehash); |
+ |
+ foreach $filehash (@{$chg_hashref->{'Files'}}) { |
+ my($file) = $filehash->{'Filename'}; |
+ if (!Move_File("${incoming_dir}/${file}", "${pkg_dir}/${file}", |
+ $Options{'pool_file_mode'})) { |
+ $Error = "Failed to move '${incoming_dir}/${file}' "; |
+ $Error .= "to '${pkg_dir}/${file}': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ } |
+ |
+ # Generate and install .package and .source metadata files. |
+ |
+ my($pkg_file) = Generate_Package($chg_hashref); |
+ |
+ if (!defined($pkg_file)) { |
+ $Error = "Failed to generate .package file: $Error"; |
+ return undef; |
+ } |
+ |
+ my($target) = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . '.package'; |
+ |
+ if (!Move_File($pkg_file, $target, $Options{'pool_file_mode'})) { |
+ $Error = "Failed to move '$pkg_file' to '$target': "; |
+ $Error .= $DebPool::Util::Error; |
+ return 0; |
+ } |
+ |
+ if (defined($dsc) && defined($dsc_hashref)) { |
+ my($src_file) = Generate_Source($dsc, $dsc_hashref, $chg_hashref); |
+ |
+ if (!defined($src_file)) { |
+ $Error = "Failed to generate .source file: $Error"; |
+ return undef; |
+ } |
+ |
+ $target = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . '.source'; |
+ |
+ if (!Move_File($src_file, $target, $Options{'pool_file_mode'})) { |
+ $Error = "Failed to move '$src_file' to '$target': "; |
+ $Error .= $DebPool::Util::Error; |
+ return 0; |
+ } |
+ } |
+ |
+ # Finally, try to install the changes file to the installed directory. |
+ |
+ if (!Move_File("$incoming_dir/$changes", "$installed_dir/$changes", |
+ $Options{'installed_file_mode'})) { |
+ $Error = "Failed to move '$incoming_dir/$changes' to "; |
+ $Error .= "'$installed_dir/$changes': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ # Update the various databases. |
+ |
+ my($distribution); |
+ |
+ # This whole block is just to calculate the component. What a stupid |
+ # setup - it should be in the changes file. Oh well. |
+ |
+ my(@filearray) = @{$chg_hashref->{'Files'}}; |
+ my($fileref) = $filearray[0]; |
+ my($section) = $fileref->{'Section'}; |
+ my($component) = Strip_Subsection($section); |
+ |
+ foreach $distribution (@{$distributions}) { |
+ Set_Versions($distribution, $pkg_name, $pkg_ver, |
+ $chg_hashref->{'Files'}); |
+ $ComponentDB{$distribution}->{$pkg_name} = $component; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Reject_Package($changes, $chg_hashref) |
+# |
+# Move all of the package files for $chg_hashref (which should be a |
+# Parse_Changes result hash) into the rejected directory, as well as the |
+# file in $changes. Returns 1 if successful, 0 if not (and sets $Error). |
+ |
+sub Reject_Package { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::DB qw(:functions); |
+ use DebPool::Util qw(:functions); |
+ |
+ my($changes, $chg_hashref) = @_; |
+ |
+ my($incoming_dir) = $Options{'incoming_dir'}; |
+ my($reject_dir) = $Options{'reject_dir'}; |
+ my($reject_file_mode) = $Options{'reject_file_mode'}; |
+ |
+ # Walk the File Hash, moving each file to the rejected directory. |
+ |
+ my($filehash); |
+ |
+ foreach $filehash (@{$chg_hashref->{'Files'}}) { |
+ my($file) = $filehash->{'Filename'}; |
+ if (!Move_File("$incoming_dir/$file", "$reject_dir/$file", |
+ $reject_file_mode)) { |
+ $Error = "Failed to move '$incoming_dir/$file' "; |
+ $Error .= "to '$reject_dir/$file': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ } |
+ |
+ # Now move the changes file to the rejected directory, as well. |
+ |
+ if (!Move_File("$incoming_dir/$changes", "$reject_dir/$changes", |
+ $reject_file_mode)) { |
+ $Error = "Failed to move '$incoming_dir/$changes' to "; |
+ $Error .= "'$reject_dir/$changes': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Verify_MD5($file, $md5) |
+# |
+# Verifies the MD5 checksum of $file against $md5. Returns 1 if it matches, |
+# 0 if it doesn't, and undef (also setting $Error) if an error occurs. This |
+# routine uses the dpkg md5sum utility, to avoid pulling in a dependancy on |
+# Digest::MD5. |
+ |
+sub Verify_MD5 { |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($file, $md5) = @_; |
+ |
+ # Read in and mangle the md5 output. |
+ |
+ if (! -r $file) { # The file doesn't exist! Will be hard to checksum it... |
+ my($msg) = "MD5 checksum unavailable: file '$file' does not exist!"; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ return 0; |
+ } |
+ |
+ my($cmd_result) = `/usr/bin/md5sum $file`; |
+ if (!$cmd_result) { # Failed to run md5sum for some reason |
+ my($msg) = "MD5 checksum unavailable: file '$file'"; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ return 0; |
+ } |
+ |
+ $cmd_result =~ m/^([[:xdigit:]]+)\s+/; |
+ my($check_md5) = $1; |
+ |
+ if ($md5 ne $check_md5) { |
+ my($msg) = "MD5 checksum failure: file '$file', "; |
+ $msg .= "expected '$md5', got '$check_md5'"; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Audit_Package($package, $chg_hashref) |
+# |
+# Delete a package and changes files for the named (source) package which |
+# are not referenced by any version currently found in the various release |
+# databases. Returns the number of files unlinked (which may be 0), or |
+# undef (and sets $Error) on an error. |
+ |
+sub Audit_Package { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Dirs qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($package, $changes_hashref) = @_; |
+ |
+ my($installed_dir) = $Options{'installed_dir'}; |
+ my($pool_dir) = $Options{'pool_dir'}; |
+ |
+ my($section) = Guess_Section($changes_hashref); |
+ my($package_dir) = join('/', |
+ ($pool_dir, PoolDir($package, $section), $package)); |
+ |
+ my(@changes) = grep(/${package}_/, Scan_Changes($installed_dir)); |
+ |
+ my($pool_scan) = Scan_All($package_dir); |
+ if (!defined($pool_scan)) { |
+ $Error = $DebPool::Dirs::Error; |
+ return undef; |
+ } |
+ my(@pool_files) = @{$pool_scan}; |
+ |
+ # Go through each file found in the pool directory, and determine its |
+ # version. If it isn't in the current version tables, unlink it. |
+ |
+ my($file); |
+ my($unlinked) = 0; |
+ foreach $file (@pool_files) { |
+ my($orig) = 0; |
+ my($deb) = 0; |
+ my($src) = 0; |
+ my($bin_package, $version); |
+ |
+ if ($file =~ m/^([^_]+)_([^_]+)\.orig\.tar\.gz$/) { # orig.tar.gz |
+ $bin_package = $1; |
+ $version = $2; |
+ $src = 1; |
+ $orig = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)\.tar\.gz$/) { # tar.gz |
+ $bin_package = $1; |
+ $version = $2; |
+ $src = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)\.diff\.gz$/) { # diff.gz |
+ $bin_package = $1; |
+ $version = $2; |
+ $src = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)\.dsc$/) { # dsc |
+ $bin_package = $1; |
+ $version = $2; |
+ $src = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)_.+\.deb$/) { # deb |
+ $bin_package = $1; |
+ $version = $2; |
+ $deb = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)_.+\.udeb$/) { # udeb |
+ $bin_package = $1; |
+ $version = $2; |
+ $deb = 1; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)\.package$/) { # package metadata |
+ $bin_package = $1; |
+ $version = $2; |
+ } elsif ($file =~ m/^([^_]+)_([^_]+)\.source$/) { # source metadata |
+ $bin_package = $1; |
+ $version = $2; |
+ } else { |
+ Log_Message("Couldn't figure out filetype for '$package_dir/$file'", |
+ LOG_AUDIT, LOG_ERROR); |
+ next; |
+ } |
+ |
+ # Skip it if we recognize it as a valid version. |
+ |
+ my($matched) = 0; |
+ my($dist); |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ my($ver_pkg); |
+ if ($src) { |
+ $ver_pkg = 'source'; |
+ } elsif ($deb) { |
+ $ver_pkg = $bin_package; |
+ } else { |
+ $ver_pkg = 'meta'; |
+ } |
+ |
+ my($dist_ver) = Get_Version($dist, $package, $ver_pkg); |
+ next if (!defined($dist_ver)); # No version in specified dist |
+ $dist_ver = Strip_Epoch($dist_ver); |
+ if ($orig) { $dist_ver =~ s/-.+$//; } |
+ if ($version eq $dist_ver) { $matched = 1; } |
+ } |
+ next if $matched; |
+ |
+ # Otherwise, unlink it. |
+ |
+ if (unlink("$package_dir/$file")) { |
+ $unlinked += 1; |
+ Log_Message("Unlinked obsolete pool file '$package_dir/$file'", |
+ LOG_AUDIT, LOG_DEBUG); |
+ } else { |
+ Log_Message("Couldn't obsolete pool file '$package_dir/$file'", |
+ LOG_AUDIT, LOG_ERROR); |
+ } |
+ } |
+ |
+ foreach $file (@changes) { |
+ $file =~ m/^[^_]+_([^_]+)_.+$/; # changes |
+ my($version) = $1; |
+ |
+ my($matched) = 0; |
+ my($dist); |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ my($dist_ver) = Get_Version($dist, $package, 'meta'); |
+ next if (!defined($dist_ver)); # No version in specified dist |
+ $dist_ver = Strip_Epoch($dist_ver); |
+ if ($version eq $dist_ver) { $matched = 1; } |
+ } |
+ next if $matched; |
+ |
+ if (unlink("$installed_dir/$file")) { |
+ $unlinked += 1; |
+ Log_Message("Unlinked obsolete changes file " . |
+ "'$installed_dir/$file'", LOG_AUDIT, LOG_DEBUG); |
+ } else { |
+ Log_Message("Couldn't obsolete changes file " . |
+ "'$installed_dir/$file'", LOG_AUDIT, LOG_ERROR); |
+ } |
+ } |
+ |
+ return $unlinked; |
+} |
+ |
+# Generate_Package($chg_hashref) |
+# |
+# Generates a .package metadata file (Packages entries for each binary |
+# package) in the tempfile area, and returns the filename. Returns undef |
+# (and sets $Error) on failure. |
+ |
+sub Generate_Package { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Dirs qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($changes_data) = @_; |
+ my($source) = $changes_data->{'Source'}; |
+ my(@files) = @{$changes_data->{'Files'}}; |
+ my($pool_base) = PoolBasePath(); |
+ |
+ # Grab a temporary file. |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ my(@packages) = @{$changes_data->{'Binary'}}; |
+ my(@architectures) = @{$changes_data->{'Architecture'}}; |
+ @architectures = grep(!/source/, @architectures); # Source is on it's own. |
+ |
+ my($package, $arch); |
+ |
+ foreach $package (@packages) { |
+ foreach $arch (@architectures) { |
+ # Construct a pattern to match the filename and nothing else. |
+ # This used to be an exact match using the source version, but |
+ # Debian's standards are sort of insane, and the version number |
+ # on binary files is not always the same as that on the source |
+ # file (nor is it even something simple like "source version |
+ # without the epoch" -- it is more or less arbitrary, as long |
+ # as it is a well-formed version number). |
+ |
+ my($filepat) = "${package}_.*_${arch}\\.deb"; |
+ $filepat =~ s/\+/\\\+/; |
+ |
+ my($section) = Guess_Section($changes_data); |
+ my($pool) = join('/', (PoolDir($source, $section), $source)); |
+ |
+ my($marker) = -1; |
+ my($count) = 0; |
+ |
+ # Step through each file, match against filename. Save matches |
+ # for later use. |
+ |
+ for $count (0..$#files) { |
+ if ($files[$count]->{'Filename'} =~ m/$filepat/) { |
+ $marker = $count; |
+ } |
+ } |
+ |
+ # The changes file has a stupid quirk; it puts all binaries from |
+ # a package in the Binary: line, even if they weren't built (for |
+ # example, an Arch: all doc package when doing an arch-only build |
+ # for a port). So if we didn't find a .deb file for it, assume |
+ # that it's one of those, and skip, rather than choking on it. |
+ |
+ next if (-1 == $marker); |
+ |
+ # Run Dpkg_Info to grab the dpkg --info data on the package. |
+ |
+ my($file) = $files[$marker]->{'Filename'}; |
+ my($info) = Dpkg_Info("$Options{'pool_dir'}/$pool/$file"); |
+ |
+ # Dump all of our data into the metadata tempfile. |
+ |
+ print $tmpfile_handle "Package: $package\n"; |
+ |
+ if (defined($info->{'Priority'})) { |
+ print $tmpfile_handle "Priority: $info->{'Priority'}\n"; |
+ } |
+ |
+ if (defined($info->{'Section'})) { |
+ print $tmpfile_handle "Section: $info->{'Section'}\n"; |
+ } |
+ |
+ if (defined($info->{'Essential'})) { |
+ print $tmpfile_handle "Essential: $info->{'Essential'}\n"; |
+ } |
+ |
+ print $tmpfile_handle "Installed-Size: $info->{'Installed-Size'}\n"; |
+ |
+ print $tmpfile_handle "Maintainer: $changes_data->{'Maintainer'}\n"; |
+ print $tmpfile_handle "Architecture: $arch\n"; |
+ print $tmpfile_handle "Source: $source\n"; |
+ print $tmpfile_handle "Version: $changes_data->{'Version'}\n"; |
+ |
+ # All of the inter-package relationships go together, and any |
+ # one of them can potentially be empty (and omitted). |
+ |
+ my($field); |
+ foreach $field (@Relationship_Fields) { |
+ if (defined($info->{$field})) { |
+ print $tmpfile_handle "${field}: $info->{$field}\n"; |
+ } |
+ } |
+ |
+ # And now, some stuff we can grab out of the parsed changes |
+ # data far more easily than anywhere else. |
+ |
+ print $tmpfile_handle "Filename: $pool_base/$pool/$file\n"; |
+ |
+ print $tmpfile_handle "Size: $files[$marker]->{'Size'}\n"; |
+ print $tmpfile_handle "MD5sum: $files[$marker]->{'MD5Sum'}\n"; |
+ |
+ print $tmpfile_handle "Description: $info->{'Description'}"; |
+ } |
+ |
+ print $tmpfile_handle "\n"; |
+ } |
+ |
+ # All done |
+ |
+ close($tmpfile_handle); |
+ return $tmpfile_name; |
+} |
+ |
+# Generate_Source($dsc, $dsc_hashref, $changes_hashref) |
+# |
+# Generates a .source metadata file (Sources entries for the source |
+# package) in the tempfile area, and returns the filename. Returns undef |
+# (and sets $Error) on failure. |
+ |
+sub Generate_Source { |
+ use DebPool::Dirs qw(:functions); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($dsc, $dsc_data, $changes_data) = @_; |
+ my($source) = $dsc_data->{'Source'}; |
+ my(@files) = @{$dsc_data->{'Files'}}; |
+ |
+ # Figure out the priority and section, using the DSC filename and |
+ # the Changes file data. |
+ |
+ my($section, $priority); |
+ my($filehr); |
+ foreach $filehr (@{$changes_data->{'Files'}}) { |
+ if ($filehr->{'Filename'} eq $dsc) { |
+ $section = $filehr->{'Section'}; |
+ $priority = $filehr->{'Priority'}; |
+ } |
+ } |
+ |
+ # Grab a temporary file. |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ # Dump out various metadata. |
+ |
+ print $tmpfile_handle "Package: $source\n"; |
+ print $tmpfile_handle "Binary: " . join(', ', @{$dsc_data->{'Binary'}}) . "\n"; |
+ print $tmpfile_handle "Version: $dsc_data->{'Version'}\n"; |
+ print $tmpfile_handle "Priority: $priority\n"; |
+ print $tmpfile_handle "Section: $section\n"; |
+ print $tmpfile_handle "Maintainer: $dsc_data->{'Maintainer'}\n"; |
+ |
+ if (defined($dsc_data->{'Build-Depends'})) { |
+ print $tmpfile_handle 'Build-Depends: '; |
+ print $tmpfile_handle join(', ', @{$dsc_data->{'Build-Depends'}}) . "\n"; |
+ } |
+ |
+ if (defined($dsc_data->{'Build-Depends-Indep'})) { |
+ print $tmpfile_handle 'Build-Depends-Indep: '; |
+ print $tmpfile_handle join(', ', @{$dsc_data->{'Build-Depends-Indep'}}) . "\n"; |
+ } |
+ |
+ print $tmpfile_handle 'Architecture: '; |
+ print $tmpfile_handle join(' ', @{$dsc_data->{'Architecture'}}) . "\n"; |
+ |
+ print $tmpfile_handle "Standards-Version: $dsc_data->{'Standards-Version'}\n"; |
+ print $tmpfile_handle "Format: $dsc_data->{'Format'}\n"; |
+ print $tmpfile_handle "Directory: " . join('/', |
+ (PoolBasePath(), PoolDir($source, $section), $source)) . "\n"; |
+ |
+ print $tmpfile_handle "Files:\n"; |
+ |
+ my($fileref); |
+ foreach $fileref (@files) { |
+ print $tmpfile_handle " $fileref->{'MD5Sum'}"; |
+ print $tmpfile_handle " $fileref->{'Size'}"; |
+ print $tmpfile_handle " $fileref->{'Filename'}\n"; |
+ } |
+ |
+ print $tmpfile_handle "\n"; |
+ |
+ # All done |
+ |
+ close($tmpfile_handle); |
+ return $tmpfile_name; |
+} |
+ |
+# Dpkg_Info($file) |
+# |
+# Runs dpkg --info on $file, and returns a hash of relevant information. |
+# |
+# Internal support function for Generate_Package. |
+ |
+sub Dpkg_Info { |
+ my($file) = @_; |
+ my(%result); |
+ |
+ # Grab the info from dpkg --info. |
+ |
+ my(@info) = `/usr/bin/dpkg --info $file`; |
+ my($smashed) = join('', @info); |
+ |
+ # Look for each of these fields in the info. All are single line values, |
+ # so the matching is fairly easy. |
+ |
+ my($field); |
+ |
+ foreach $field (@Info_Fields, @Relationship_Fields) { |
+ if ($smashed =~ m/\n ${field}:\s+(\S.*)\n/) { |
+ $result{$field} = $1; |
+ } |
+ } |
+ |
+ # And, finally, grab the description. |
+ |
+ my($line); |
+ my($found) = 0; |
+ foreach $line (@info) { |
+ if ($found) { |
+ $line =~ s/^ //; |
+ $result{'Description'} .= $line; |
+ } elsif ($line =~ m/^ Description: (.+)/) { |
+ $result{'Description'} = "$1\n"; |
+ $found = 1; |
+ } |
+ } |
+ |
+ return \%result; |
+} |
+ |
+# Install_List($archive, $component, $architecture, $listfile, $gzfile) |
+# |
+# Installs a distribution list file (from Generate_List), along with an |
+# optional gzipped version of the same file (if $gzfile is defined). |
+# Returns 1 on success, or 0 (and sets $Error) on failure. |
+ |
+sub Install_List { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Dirs qw(:functions); |
+ |
+ my($archive, $component, $architecture, $listfile, $gzfile) = @_; |
+ |
+ my($dists_file_mode) = $Options{'dists_file_mode'}; |
+ my($inst_file) = "$Options{'dists_dir'}/"; |
+ $inst_file .= Archfile($archive, $component, $architecture, 0); |
+ |
+ # Now install the file(s) into the appropriate place(s). |
+ |
+ if (!Move_File($listfile, $inst_file, $dists_file_mode)) { |
+ $Error = "Couldn't install distribution file '$listfile' "; |
+ $Error .= "to '${inst_file}': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ if (defined($gzfile) && !Move_File($gzfile, "${inst_file}.gz", |
+ $dists_file_mode)) { |
+ $Error = "Couldn't install gzipped distribution file '$gzfile' "; |
+ $Error .= "to '${inst_file}.gz': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Guess_Section($changes_hashref) |
+# |
+# Attempt to guess the freeness section of a package based on the data |
+# for the first file listed in the changes. |
+ |
+sub Guess_Section { |
+ # Pull out the primary section from the changes data. Note that this is |
+ # a cheap hack, but it is mostly used when needing the pool directory |
+ # section, which is based solely on freeness-sections (main, contrib, |
+ # non-free). |
+ |
+ my($changes_hashref) = @_; |
+ |
+ my(@changes_files) = @{$changes_hashref->{'Files'}}; |
+ return $changes_files[0]->{'Section'}; |
+} |
+ |
+# Strip_Epoch($version) |
+# |
+# Strips any epoch data off of the version. |
+ |
+sub Strip_Epoch { |
+ my($version) = @_; |
+ |
+ $version =~ s/^[^:]://; |
+ return $version; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/GnuPG.pm |
=================================================================== |
--- trunk/share/DebPool/GnuPG.pm (nonexistent) |
+++ trunk/share/DebPool/GnuPG.pm (revision 3) |
@@ -0,0 +1,305 @@ |
+package DebPool::GnuPG; |
+ |
+### |
+# |
+# DebPool::GnuPG - Module for all interactions with GNU Privacy Guard |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: GnuPG.pm 46 2005-02-12 17:52:37Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+use POSIX; # WEXITSTATUS |
+use File::Temp qw(tempfile); |
+ |
+# We need these for open2() |
+ |
+use Fcntl; |
+use IPC::Open2; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Check_Signature |
+ &Sign_Release |
+ &Strip_GPG |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Check_Signature &Sign_Release &Strip_GPG)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Check_Signature($file, $signature) |
+# |
+# Checks the GPG signature of $file (using $signature as an external |
+# signature file, if it is defined; if it isn't, $file is assumed to have |
+# an internal signature). Returns 0 on failure, 1 on success. |
+ |
+sub Check_Signature { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($file, $signature) = @_; |
+ |
+ my(@args) = ("--homedir=$Options{'gpg_home'}"); |
+ push (@args, '--no-default-keyring', '--logger-fd=1'); |
+ |
+ my($keyring); |
+ |
+ foreach $keyring (@{$Options{'gpg_keyrings'}}) { |
+ push(@args, "--keyring=$keyring"); |
+ } |
+ |
+ push(@args, '--verify'); |
+ |
+ if (defined($signature)) { |
+ push(@args, $signature); |
+ } |
+ |
+ push(@args, $file); |
+ |
+ my($pid) = IPC::Open2::open2(*GPG_IN, *GPG_OUT, $Options{'gpg_bin'}, @args); |
+ close(GPG_IN); # No input |
+ close(GPG_OUT); # Don't care about output, really, either |
+ |
+ waitpid($pid,0); # No flags, just wait. |
+ my($sysret) = WEXITSTATUS($?); |
+ |
+ if (0 != $sysret) { # Failure |
+ my($msg) = "Failed signature check on '$file' "; |
+ if (defined($signature)) { |
+ $msg .= "(signature file '$signature')"; |
+ } else { |
+ $msg .= "(internal signature)"; |
+ } |
+ Log_Message($msg, LOG_GPG, LOG_WARNING); |
+ |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Sign_Release($release_file) |
+# |
+# Generates a detached GPG signature file for $release_file, and returns |
+# the filename. Returns undef, if an error occurs (and sets $Error). |
+ |
+sub Sign_Release { |
+ use DebPool::Config; |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ my($release_file) = @_; |
+ |
+ # Check that we have everything we need |
+ |
+ if (!defined($Options{'gpg_sign_key'})) { |
+ $Error = "No GPG signature key enabled"; |
+ return undef; |
+ } |
+ |
+ if (!defined($Options{'gpg_passfile'})) { |
+ $Error = "No GPG passphrase file enabled"; |
+ return undef; |
+ } |
+ |
+ # Open a secure tempfile to write the signature to |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ # Open the Release file and grab the data from it |
+ |
+ if (!open(RELEASE, '<', $release_file)) { |
+ $Error = "Couldn't open Release file '$release_file': $!"; |
+ return undef; |
+ } |
+ my(@release_text) = <RELEASE>; |
+ close(RELEASE); |
+ |
+ # Open the passphrase file and grab the data from it |
+ |
+ if (!open(PASS, '<', $Options{'gpg_passfile'})) { |
+ $Error = "Couldn't open passphrase file '$Options{'gpg_passfile'}': $!"; |
+ return undef; |
+ } |
+ my($passphrase) = <PASS>; # This is only safe because we don't care. |
+ close(PASS); |
+ |
+ # We are go for main engine start |
+ |
+ my(@args) = ("--homedir=$Options{'gpg_home'}"); |
+ push(@args, "--default-key=$Options{'gpg_sign_key'}"); |
+ push(@args, '--passphrase-fd=0', '--batch', '--no-tty', '--detach-sign'); |
+ push(@args, '--armor', '--output=-'); |
+ |
+ my($gnupg_pid) = IPC::Open2::open2(*GPG_IN, *GPG_OUT, $Options{'gpg_bin'}, @args); |
+ |
+ my($child_pid); |
+ my(@signature); |
+ if ($child_pid = fork) { # In the parent |
+ # Close filehandles used by the child. |
+ |
+ close(GPG_IN); |
+ close($tmpfile_handle); |
+ |
+ # Send all the data to GnuPG |
+ |
+ print GPG_OUT $passphrase; |
+ print GPG_OUT @release_text; |
+ close(GPG_OUT); |
+ |
+ waitpid($child_pid, 0); |
+ } else { # In the child - we hope |
+ if (!defined($child_pid)) { |
+ die "Couldn't fork: $!\n"; |
+ } |
+ |
+ # Close filehandle used by the parent. |
+ |
+ close(GPG_OUT); |
+ |
+ # And read back the results |
+ |
+ @signature = <GPG_IN>; |
+ close(GPG_IN); |
+ |
+ # Finally, print the results to the tempfile |
+ |
+ print $tmpfile_handle @signature; |
+ close($tmpfile_handle); |
+ |
+ exit(0); |
+ } |
+ |
+ |
+ # And we're done |
+ |
+ return $tmpfile_name; |
+} |
+ |
+# Strip_GPG(@text) |
+# |
+# Goes through @text and determine if it has GnuPG headers; if so, strip |
+# out the headers, and undo GnuPG's header protection ('^-' -> '^-- -'). |
+ |
+sub Strip_GPG { |
+ my(@text) = @_; |
+ |
+ my($count); |
+ my($header, $firstblank, $sigstart, $sigend); |
+ |
+ for $count (0..$#text) { |
+ if ($text[$count] =~ m/^-----BEGIN PGP SIGNED MESSAGE-----$/) { |
+ $header = $count; |
+ } elsif (!defined($firstblank) && $text[$count] =~ m/^$/) { |
+ $firstblank = $count; |
+ } elsif ($text[$count] =~ m/^-----BEGIN PGP SIGNATURE-----$/) { |
+ $sigstart = $count; |
+ } elsif ($text[$count] =~ m/^-----END PGP SIGNATURE-----$/) { |
+ $sigend = $count; |
+ } |
+ } |
+ |
+ # If we didn't find all three parts, it isn't a validly signed message |
+ # (or it's externally signed, but that might as well be the same |
+ # thing for our purposes - there's nothing to remove). |
+ |
+ if (!defined($header) || !defined($sigstart) || !defined($sigend)) { |
+ return @text; |
+ } |
+ |
+ # Okay. Back to front, so that we don't muck up reference numbers. |
+ # First, we rip out the signature data by splicing it with an empty |
+ # list. |
+ |
+ splice(@text, $sigstart, ($sigend - $sigstart) + 1); |
+ |
+ # We used to just rip off the first 3 lines (BEGIN line, hash header, |
+ # and a blank line). However, this was a cheap shortcut that broke as |
+ # of GnuPG 1.0.7, because it relied on there being exactly one GnuPG |
+ # header line. |
+ # |
+ # Now, we rip out everything from the header line to the first blank, |
+ # which should always be correct. |
+ |
+ splice(@text, $header, ($firstblank - $header) + 1); |
+ |
+ # All done. Fire it back. |
+ |
+ return @text; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Release.pm |
=================================================================== |
--- trunk/share/DebPool/Release.pm (nonexistent) |
+++ trunk/share/DebPool/Release.pm (revision 3) |
@@ -0,0 +1,357 @@ |
+package DebPool::Release; |
+ |
+### |
+# |
+# DebPool::Release - Module for generating and installing Release files |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Release.pm 27 2004-11-07 03:06:59Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+use POSIX; # strftime |
+use File::Temp qw(tempfile); |
+ |
+# We need the Digest modules so that we can calculate the proper checksums. |
+ |
+use Digest::MD5; |
+use Digest::SHA1; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Generate_Release_Triple |
+ &Install_Release |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Generate_Release_Triple &Install_Release)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+# Magic filenames - these are files we want to include hashes for in a |
+# Release file. |
+ |
+my(@SigFiles) = ( |
+ 'Packages', |
+ 'Sources', |
+ 'Packages.gz', |
+ 'Sources.gz', |
+); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Generate_Release_Triple($archive, $component, $architecture, $version) |
+# |
+# Generate a Release file for a specific dist/component/arch, in the |
+# temp/working area, and return the filename. |
+# |
+# Returns undef (and sets $Error) on error. |
+ |
+sub Generate_Release_Triple { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Dirs qw(:functions); |
+ |
+ my($archive, $component, $architecture, $version) = @_; |
+ |
+ my(%Checksums); |
+ |
+ # Before we bother to do much else, generate the MD5 and SHA1 checksums |
+ # we'll need later. This is mostly so that we can catch errors before |
+ # ever bothering to open a tempfile. |
+ |
+ # First, grab a list of files from the directory. |
+ |
+ my($dirpath) = "${Options{'dists_dir'}}/"; |
+ $dirpath .= Archfile($archive, $component, $architecture, 1); |
+ |
+ if (!opendir(RELDIR, $dirpath)) { |
+ $Error = "Couldn't open directory '$dirpath'."; |
+ return undef; |
+ } |
+ |
+ my(@dirfiles) = readdir(RELDIR); |
+ close(RELDIR); |
+ |
+ # Now, for each file, generate MD5 and SHA1 checksums, and put them |
+ # into Checksums for later use (assuming it's a file we care about). |
+ |
+ my($ck_file); |
+ |
+ foreach $ck_file (@dirfiles) { |
+ if (0 == grep(/^$ck_file$/, @SigFiles)) { # We don't care about it. |
+ next; |
+ } |
+ |
+ # Grab the filesize from stat() |
+ |
+ my(@stat) = stat("${dirpath}/${ck_file}"); |
+ my($size) = $stat[7]; |
+ |
+ # Open the file and read in the contents. This could be a very |
+ # large amount of data, but unfortunately, both Digest routines |
+ # require the entire thing at once. |
+ |
+ if (!open(CK_FILE, '<', "${dirpath}/${ck_file}")) { |
+ $Error = "Couldn't open file '${dirpath}/${ck_file}' for reading."; |
+ return undef; |
+ } |
+ |
+ my(@filetext) = <CK_FILE>; |
+ close(CK_FILE); |
+ |
+ # Now calculate the checksums and put them into the hashes. |
+ |
+ my($md5) = Digest::MD5::md5_hex(@filetext); |
+ my($sha1) = Digest::SHA1::sha1_hex(@filetext); |
+ |
+ $Checksums{$ck_file} = { |
+ 'Size' => $size, |
+ 'MD5' => $md5, |
+ 'SHA1' => $sha1, |
+ }; |
+ } |
+ |
+ # Open a secure tempfile, and write the headers to it. |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ print $tmpfile_handle "Archive: $archive\n"; |
+ print $tmpfile_handle "Component: $component\n"; |
+ print $tmpfile_handle "Version: $version\n"; |
+ print $tmpfile_handle "Origin: $Options{'release_origin'}\n"; |
+ print $tmpfile_handle "Label: $Options{'release_label'}\n"; |
+ print $tmpfile_handle "Architecture: $architecture\n"; |
+ |
+ # If the archive (aka distribution) appears in release_noauto, print |
+ # the appropriate directive. |
+ |
+ if (0 != grep(/^$archive$/, @{$Options{'release_noauto'}})) { |
+ print $tmpfile_handle "NotAutomatic: yes\n"; |
+ } |
+ |
+ print $tmpfile_handle "Description: $Options{'release_description'}\n"; |
+ |
+ # Now print MD5 and SHA1 checksum lists. |
+ |
+ print $tmpfile_handle "MD5Sum:\n"; |
+ foreach $ck_file (keys(%Checksums)) { |
+ printf $tmpfile_handle " %s %8d %s\n", $Checksums{$ck_file}->{'MD5'}, |
+ $Checksums{$ck_file}->{'Size'}, $ck_file; |
+ } |
+ |
+ print $tmpfile_handle "SHA1:\n"; |
+ foreach $ck_file (keys(%Checksums)) { |
+ printf $tmpfile_handle " %s %8d %s\n", $Checksums{$ck_file}->{'SHA1'}, |
+ $Checksums{$ck_file}->{'Size'}, $ck_file; |
+ } |
+ |
+ close($tmpfile_handle); |
+ |
+ return $tmpfile_name; |
+} |
+ |
+# Generate_Release_Dist($archive, $version, @files) |
+# |
+# Generate top-level Release file for a specific distribution, covering the |
+# given files, in the temp/working area, and return the filename. |
+# |
+# Filenames in @files should be relative to <dists_dir>/<archive>, with no |
+# leading slash (ie, main/binary-i386/Packages). |
+# |
+# Returns undef (and sets $Error) on error. |
+ |
+sub Generate_Release_Dist { |
+ use DebPool::Config qw(:vars); |
+ |
+ my($archive) = shift(@_); |
+ my($version) = shift(@_); |
+ my(@files) = @_; |
+ |
+ my(%Checksums); |
+ my($dists_dir) = $Options{'dists_dir'}; |
+ |
+ # Before we bother to do much else, generate the MD5 and SHA1 checksums |
+ # we'll need later. This is mostly so that we can catch errors before |
+ # ever bothering to open a tempfile. |
+ |
+ my($file); |
+ for $file (@files) { |
+ my($fullfile) = "${dists_dir}/${archive}/${file}"; |
+ |
+ # Now, for each file, generate MD5 and SHA1 checksums, and put them |
+ # into Checksums for later use (assuming it's a file we care about). |
+ |
+ my(@stat) = stat($fullfile); |
+ my($size) = $stat[7]; |
+ |
+ if (!open(HASH_FILE, '<', $fullfile)) { |
+ $Error = "Couldn't open file '${fullfile} for reading."; |
+ return undef; |
+ } |
+ my(@filetext) = <HASH_FILE>; |
+ close(HASH_FILE); |
+ |
+ # Now calculate the checksums and put them into the hashes. |
+ |
+ my($md5) = Digest::MD5::md5_hex(@filetext); |
+ my($sha1) = Digest::SHA1::sha1_hex(@filetext); |
+ |
+ $Checksums{$file} = { |
+ 'Size' => $size, |
+ 'MD5' => $md5, |
+ 'SHA1' => $sha1, |
+ }; |
+ } |
+ |
+ # Open a secure tempfile, and set up some variables. |
+ |
+ my($tmpfile_handle, $tmpfile_name) = tempfile(); |
+ |
+ my($now_822) = strftime('%a, %d %b %Y %H:%M:%S %Z', localtime()); |
+ my(@archs) = grep(!/^source$/, @{$Options{'archs'}}); |
+ my($suite) = $Options{'reverse_dists'}->{$archive}; |
+ |
+ # Write the headers into the Release tempfile |
+ |
+ print $tmpfile_handle "Origin: ${Options{'release_origin'}}\n"; |
+ print $tmpfile_handle "Label: ${Options{'release_label'}}\n"; |
+ print $tmpfile_handle "Suite: ${suite}\n"; |
+ print $tmpfile_handle "Codename: ${archive}\n"; |
+ print $tmpfile_handle "Date: ${now_822}\n"; |
+ print $tmpfile_handle "Architectures: " . join(' ', @archs) . "\n"; |
+ print $tmpfile_handle "Components: " . join(' ', @{$Options{'sections'}}) . "\n"; |
+ print $tmpfile_handle "Description: $Options{'release_description'}\n"; |
+ |
+ # Now print MD5 and SHA1 checksum lists. |
+ |
+ print $tmpfile_handle "MD5Sum:\n"; |
+ foreach $file (keys(%Checksums)) { |
+ printf $tmpfile_handle " %s %8d %s\n", $Checksums{$file}->{'MD5'}, |
+ $Checksums{$file}->{'Size'}, $file; |
+ } |
+ |
+ print $tmpfile_handle "SHA1:\n"; |
+ foreach $file (keys(%Checksums)) { |
+ printf $tmpfile_handle " %s %8d %s\n", $Checksums{$file}->{'SHA1'}, |
+ $Checksums{$file}->{'Size'}, $file; |
+ } |
+ |
+ close($tmpfile_handle); |
+ |
+ return $tmpfile_name; |
+} |
+ |
+# Install_Release($archive, $component, $architecture, $release, $signature) |
+# |
+# Installs a release file and an optional signature file to the |
+# distribution directory specified by the ($archive, $component, |
+# $architecture) triple, or $archive if $component and $architecture are |
+# undefined. Returns 0 (and sets $Error) on failure, 1 on |
+# success. |
+ |
+sub Install_Release { |
+ use DebPool::Config qw(:vars); |
+ use DebPool::Util qw(:functions); |
+ |
+ my($archive, $component, $architecture, $release, $signature) = @_; |
+ |
+ my($dists_file_mode) = $Options{'dists_file_mode'}; |
+ |
+ my($inst_dir); |
+ if (defined($architecture) && defined($component)) { |
+ $inst_dir = "${Options{'dists_dir'}}/"; |
+ $inst_dir .= Archfile($archive, $component, $architecture, 1); |
+ } else { |
+ $inst_dir = "${Options{'dists_dir'}}/${archive}"; |
+ } |
+ |
+ # Now install the file(s) into the appropriate place(s). |
+ |
+ if (!Move_File($release, "${inst_dir}/Release", $dists_file_mode)) { |
+ $Error = "Couldn't install Release file '${release}' to "; |
+ $Error .= "'${inst_dir}': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ if (defined($signature) && !Move_File($signature, "${inst_dir}/Release.gpg", |
+ $dists_file_mode)) { |
+ $Error = "Couldn't install Signature file '${signature}' to "; |
+ $Error .= "'${inst_dir}': ${DebPool::Util::Error}"; |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/share/DebPool/Dirs.pm |
=================================================================== |
--- trunk/share/DebPool/Dirs.pm (nonexistent) |
+++ trunk/share/DebPool/Dirs.pm (revision 3) |
@@ -0,0 +1,457 @@ |
+package DebPool::Dirs; |
+ |
+### |
+# |
+# DebPool::Dirs - Module for dealing with directory related tasks |
+# |
+# Copyright 2003-2004 Joel Aelwyn. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: Dirs.pm 71 2006-06-26 21:16:01Z joel $ |
+# |
+### |
+ |
+# We use 'our', so we must have at least Perl 5.6 |
+ |
+require 5.006_000; |
+ |
+# Always good ideas. |
+ |
+use strict; |
+use warnings; |
+ |
+### Module setup |
+ |
+BEGIN { |
+ use Exporter (); |
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
+ |
+ # Version checking |
+ $VERSION = '0.1.5'; |
+ |
+ @ISA = qw(Exporter); |
+ |
+ @EXPORT = qw( |
+ ); |
+ |
+ @EXPORT_OK = qw( |
+ &Archfile |
+ &Create_Tree |
+ &Monitor_Incoming |
+ &PoolBasePath |
+ &PoolDir |
+ &Scan_Changes |
+ &Scan_All |
+ &Strip_Subsection |
+ ); |
+ |
+ %EXPORT_TAGS = ( |
+ 'functions' => [qw(&Archfile &Create_Tree &Monitor_Incoming |
+ &PoolBasePath &PoolDir &Scan_Changes &Scan_All |
+ &Strip_Subsection)], |
+ 'vars' => [qw()], |
+ ); |
+} |
+ |
+### Exported package globals |
+ |
+# None |
+ |
+### Non-exported package globals |
+ |
+# Thread-safe? What's that? Package global error value. We don't export |
+# this directly, because it would conflict with other modules. |
+ |
+our($Error); |
+ |
+### File lexicals |
+ |
+# None |
+ |
+### Constant functions |
+ |
+# None |
+ |
+### Meaningful functions |
+ |
+# Create_Tree() |
+# |
+# Creates a full directory tree based on the current directory values in |
+# %DebPool::Config::Options. Returns 1 on success, 0 on failure (and sets |
+# or propagates $Error). |
+ |
+sub Create_Tree { |
+ use DebPool::Config qw(:vars); |
+ |
+ # Basic directories - none of these are terribly exciting. We don't set |
+ # $Error on failure, because Tree_Mkdir will have already done so. |
+ |
+ if (!Tree_Mkdir($Options{'db_dir'}, $Options{'db_dir_mode'})) { |
+ return 0; |
+ } |
+ |
+ if (!Tree_Mkdir($Options{'incoming_dir'}, $Options{'incoming_dir_mode'})) { |
+ return 0; |
+ } |
+ |
+ if (!Tree_Mkdir($Options{'installed_dir'}, $Options{'installed_dir_mode'})) { |
+ return 0; |
+ } |
+ |
+ if (!Tree_Mkdir($Options{'reject_dir'}, $Options{'reject_dir_mode'})) { |
+ return 0; |
+ } |
+ |
+ # Now the distribution directory and subdirectories |
+ |
+ my($dists_dir) = $Options{'dists_dir'}; |
+ my($dists_dir_mode) = $Options{'dists_dir_mode'}; |
+ |
+ if (!Tree_Mkdir($dists_dir, $dists_dir_mode)) { |
+ return 0; |
+ } |
+ |
+ # Real distributions are the only ones that get directories. |
+ |
+ my($dist); |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ if (!Tree_Mkdir("$dists_dir/$dist", $dists_dir_mode)) { |
+ return 0; |
+ } |
+ |
+ my($section); |
+ foreach $section (@{$Options{'sections'}}) { |
+ if (!Tree_Mkdir("$dists_dir/$dist/$section", $dists_dir_mode)) { |
+ return 0; |
+ } |
+ |
+ my($arch); |
+ foreach $arch (@{$Options{'archs'}}) { |
+ my($target) = "$dists_dir/$dist/$section/"; |
+ if ('source' eq $arch) { |
+ $target .= $arch; |
+ } else { |
+ $target .= "binary-$arch"; |
+ } |
+ |
+ if (!Tree_Mkdir($target, $dists_dir_mode)) { |
+ return 0; |
+ } |
+ } |
+ } |
+ } |
+ |
+ # Go through all of the distributions looking for those that should be |
+ # symlinks, and creating them if necessary. |
+ |
+ foreach $dist (keys(%{$Options{'dists'}})) { |
+ # Check whether it should be a symlink. If so, make sure it is. |
+ |
+ if (!($dist eq $Options{'dists'}->{$dist})) { # Different names -> sym |
+ if (! -e "$dists_dir/$dist") { |
+ if (!symlink($Options{'dists'}->{$dist}, "$dists_dir/$dist")) { |
+ $Error = "Couldn't create symlink $dists_dir/$dist -> "; |
+ $Error .= "$Options{'dists'}->{$dist}: $!"; |
+ } |
+ } elsif (! -l "$dists_dir/$dist") { |
+ $Error = "$dists_dir/$dist exists and isn't a symlink, "; |
+ $Error .= "but it should be"; |
+ return 0; |
+ } |
+ } |
+ } |
+ |
+ # And, finally, the pool directories and their subdirectories |
+ |
+ my($pool_dir) = $Options{'pool_dir'}; |
+ my($pool_dir_mode) = $Options{'pool_dir_mode'}; |
+ |
+ if (!Tree_Mkdir($pool_dir, $pool_dir_mode)) { |
+ return 0; |
+ } |
+ |
+ # We can only get away with this because Debian pool directories are |
+ # named in ASCII... |
+ |
+ my($section); |
+ foreach $section (@{$Options{'sections'}}) { |
+ if (!Tree_Mkdir("$pool_dir/$section", $pool_dir_mode)) { |
+ return 0; |
+ } |
+ |
+ my($letter); |
+ foreach $letter ('a' .. 'z') { |
+ if (!Tree_Mkdir("$pool_dir/$section/$letter", $pool_dir_mode)) { |
+ return 0; |
+ } |
+ if (!Tree_Mkdir("$pool_dir/$section/lib$letter", $pool_dir_mode)) { |
+ return 0; |
+ } |
+ } |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Tree_Mkdir($directory, $mode) |
+# |
+# Creates $directory with $mode. Returns 0 and sets $Error on failure, or |
+# 1 on success. |
+# |
+# Internal support function for Create_Tree |
+ |
+sub Tree_Mkdir { |
+ my($dir, $mode) = @_; |
+ |
+ if (-d $dir) { |
+ return 1; |
+ }; |
+ |
+ if (-e $dir) { |
+ $Error = "Couldn't create '$dir' - already exists as a non-directory."; |
+ return 0; |
+ } |
+ |
+ if (!mkdir($dir, $mode)) { |
+ $Error = "Couldn't create '$dir': $!"; |
+ return 0; |
+ } |
+ |
+ if (!chmod($mode, $dir)) { |
+ $Error = "Couldn't chmod '$dir': $!"; |
+ return 0; |
+ } |
+ |
+ return 1; |
+} |
+ |
+# Scan_Changes($directory) |
+# |
+# Scan the specified directory for changes files. Returns an array of |
+# filenames relative to the directory, or undef (and sets $Error) on an error. |
+ |
+sub Scan_Changes { |
+ my($directory) = @_; |
+ |
+ if (!opendir(INCOMING, $directory)) { |
+ $Error = "Couldn't open directory '$directory': $!"; |
+ return undef; |
+ } |
+ |
+ # Perl magic - read the directory and grep it for *.changes all at one |
+ # shot. |
+ |
+ my(@changes) = grep(/\.changes$/, readdir(INCOMING)); |
+ close(INCOMING); |
+ |
+ return @changes; |
+} |
+ |
+# Scan_All($directory) |
+# |
+# Scans the specified directory and all subdirectories for any files. |
+# Returns an arrayref pointing to an array of filepaths relative to |
+# $directory, or undef (and sets $Error) on failure. Ignores any hidden |
+# files or directories. |
+ |
+sub Scan_All { |
+ my($directory) = @_; |
+ |
+ if (!opendir(DIR, $directory)) { |
+ $Error = "Couldn't open directory '$directory'"; |
+ return undef; |
+ } |
+ |
+ my($direntry); |
+ my(@entries) = grep(!/^\./, readdir(DIR)); |
+ |
+ my(@return); |
+ |
+ foreach $direntry (@entries) { |
+ if (-f "$directory/$direntry") { |
+ push(@return, $direntry); |
+ } elsif (-d "$directory/$direntry") { |
+ my($recurse) = Scan_All("$directory/$direntry"); |
+ |
+ if (!defined($recurse)) { # $Error is already set. |
+ return undef; |
+ } |
+ |
+ # I'd like to use map(), but Perl makes stooopid guesses. |
+ |
+ my($entry); |
+ |
+ foreach $entry (@{$recurse}) { |
+ push(@return, "$direntry/$entry"); |
+ } |
+ } |
+ } |
+ |
+ return \@return; |
+} |
+ |
+# Monitor_Incoming() |
+# |
+# Monitors the incoming directory, looping until the directory is updated. |
+# Returns 1 on success, 0 on failure (and sets $Error). |
+ |
+sub Monitor_Incoming { |
+ use DebPool::Config; |
+ use DebPool::Logging qw(:functions :facility :level); |
+ |
+ # If this is ever false, we either shouldn't have been called in the |
+ # first place, or we've caught a signal and shouldn't do anything |
+ # further. |
+ |
+ if ($DebPool::Signal::Signal_Caught) { |
+ return 1; |
+ } |
+ |
+ my(@stat) = stat($Options{'incoming_dir'}); |
+ if (!@stat) { |
+ $Error = "Couldn't stat incoming_dir '$Options{'incoming_dir'}'"; |
+ return 0; |
+ } |
+ my($mtime) = $stat[9]; |
+ |
+ do { |
+ Log_Message("Incoming monitor: sleeping for " . |
+ $Options{'sleep'} . " seconds", LOG_GENERAL, LOG_DEBUG); |
+ sleep($Options{'sleep'}); |
+ @stat = stat($Options{'incoming_dir'}); |
+ if (!@stat) { |
+ $Error = "Couldn't stat incoming_dir '$Options{'incoming_dir'}'"; |
+ return 0; |
+ } |
+ } until (($stat[9] != $mtime) || ($DebPool::Signal::Signal_Caught)); |
+ |
+ return 1; |
+} |
+ |
+# PoolDir($name, $section, $archive_base) |
+# |
+# Calculates a pool subdirectory name from the package name and the section |
+# (if provided; assumed to be 'main' if undefined or unrecognized). |
+ |
+sub PoolDir { |
+ my($name, $section, $archive_base) = @_; |
+ |
+ $section = Strip_Subsection($section); |
+ |
+ # Pool subdirectories are normally the first letter of the package |
+ # name, unless it is a lib* package, in which case the subdir is |
+ # lib<first letter>. |
+ |
+ if ($name =~ s/^lib//) { # lib(.).* |
+ return $section . '/' . 'lib' . substr($name, 0, 1); |
+ } else { # (.).* |
+ return $section . '/' . substr($name, 0, 1); |
+ } |
+} |
+ |
+# Strip_Subsection($section) |
+# |
+# This routine could, perhaps, better named. However, the purpose is to |
+# take a Section header as found in a package, and return the 'section' |
+# (rather than [section/]subsection) of it - that is, 'main', 'contrib', or |
+# 'non-free' (normally; it uses the configuration options to track this). |
+# |
+# Any unrecognized section is assumed to be 'main'; section values without |
+# *any* subsection portion succeed, as well (at least, assuming that they |
+# are otherwise valid). |
+ |
+sub Strip_Subsection { |
+ use DebPool::Config qw(:vars); |
+ |
+ my($section) = @_; |
+ |
+ if (!defined($section)) { |
+ return 'main'; |
+ } |
+ |
+ my($check_section); |
+ foreach $check_section (@{$Options{'sections'}}) { |
+ if ($section =~ m/^$check_section(\/.+)?$/) { |
+ return $check_section; |
+ } |
+ } |
+ |
+ return 'main'; |
+} |
+ |
+# PoolBasePath() |
+# |
+# Calculates the value of the relative path from archive_dir to pool_dir |
+# (this is primarily useful when having to provide file paths relative to |
+# archive_dir, such as in Packages/Sources files). This does assume that |
+# pool_dir is a subdirectory of archive_dir, but if that isn't true then |
+# things are royally screwed up *anyway*... |
+ |
+sub PoolBasePath { |
+ use DebPool::Config qw(:vars); |
+ |
+ my($path) = $Options{'pool_dir'}; |
+ $path =~ s/^$Options{'archive_dir'}\///; |
+ return $path; |
+} |
+ |
+# Archfile($archive, $component, $architecture, $dironly) |
+# |
+# Returns the file name for the Packages/Sources file, or the directory |
+# name of the arch directory if $dironly is true, (from a base of |
+# dists_dir) for the specified archive, component, and architecture. |
+ |
+sub Archfile { |
+ my($archive) = shift(@_); |
+ my($component) = shift(@_); |
+ my($architecture) = shift(@_); |
+ my($dironly) = shift(@_); |
+ |
+ my($result) = "$archive/$component"; |
+ |
+ my($type); |
+ if ('source' eq $architecture) { |
+ $result .= "/${architecture}"; |
+ $type = "Sources"; |
+ } else { |
+ $result .= "/binary-${architecture}"; |
+ $type = "Packages"; |
+ } |
+ |
+ if (!$dironly) { |
+ $result .= "/${type}"; |
+ } |
+ |
+ return $result; |
+} |
+ |
+END {} |
+ |
+1; |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
Index: trunk/bin/debpool |
=================================================================== |
--- trunk/bin/debpool (nonexistent) |
+++ trunk/bin/debpool (revision 3) |
@@ -0,0 +1,664 @@ |
+#! /usr/bin/perl -w |
+ |
+##### |
+# |
+# Copyright 2003-2004 Joel Baker. All rights reserved. |
+# |
+# Redistribution and use in source and binary forms, with or without |
+# modification, are permitted provided that the following conditions |
+# are met: |
+# 1. Redistributions of source code must retain the above copyright |
+# notice, this list of conditions and the following disclaimer. |
+# 2. Redistributions in binary form must reproduce the above copyright |
+# notice, this list of conditions and the following disclaimer in the |
+# documentation and/or other materials provided with the distribution. |
+# 3. Neither the name of the Author nor the names of any contributors |
+# may be used to endorse or promote products derived from this software |
+# without specific prior written permission. |
+# |
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
+# SUCH DAMAGE. |
+# |
+# $Id: debpool 54 2005-02-21 21:48:29Z joel $ |
+# |
+##### |
+ |
+# Put our private support module area into the search path |
+ |
+use lib '/usr/share/debpool/perl5'; |
+ |
+# We always want to be careful about things... |
+ |
+use strict; |
+use warnings; |
+ |
+use POSIX; # This gets us strftime. |
+ |
+# First things first - figure out how we need to be configured. |
+ |
+use Getopt::Long qw(:config pass_through); |
+use DebPool::Config qw(:functions :vars); |
+ |
+# First, grab --config and --nodefault options if they exist. We |
+# don't want these in the %Options hash, and they affect what we do when |
+# loading it. |
+ |
+my(@config_files); |
+my($default); |
+ |
+GetOptions('config=s' => \@config_files, 'default!' => \$default); |
+ |
+# Call Load_Default_Configs if we're loading default values, or |
+# Load_Minimal_Configs if we're not (we still need the OptionDefs hash to |
+# be populated). |
+ |
+if (!defined($default) || $default) { |
+ Load_Default_Configs(); |
+} else { |
+ Load_Minimal_Configs(); |
+} |
+ |
+# Load any config files we were given. |
+ |
+my($config); |
+ |
+foreach $config (@config_files) { |
+ Load_File_Configs($config); |
+} |
+ |
+# And finally, pull in any other command line options. |
+ |
+GetOptions(\%Options, values(%OptionDefs)); |
+ |
+# Run the cleanup stuff on %Options. |
+ |
+Clean_Options(); |
+ |
+# Okay. We're more or less ready to go. First, load some modules that we |
+# know we'll be calling. |
+ |
+use DebPool::Dirs qw(:functions :vars); # Directory management |
+use DebPool::DB qw(:functions :vars); # Various databases |
+use DebPool::GnuPG qw(:functions :vars); # GnuPG interaction routines |
+use DebPool::Gzip qw(:functions :vars); # Gzip interaction routines |
+use DebPool::Logging qw(:functions :facility :level); # Logging routines |
+use DebPool::Packages qw(:functions :vars); # Distribution databases |
+use DebPool::Signal qw(:functions :vars); # Handle signals |
+ |
+# Before we do anything else, let's find out if we need to act as a daemon, |
+# and if so, whether we can manage to pull it off. |
+ |
+if ($Options{'daemon'}) { |
+ Log_Message("Trying to enter daemon mode.", LOG_GENERAL, LOG_DEBUG); |
+ |
+ require Proc::Daemon; |
+ Proc::Daemon::Init(); |
+ |
+ Log_Message("Now running as a daemon.", LOG_GENERAL, LOG_DEBUG); |
+} |
+ |
+# Create the directory tree. This is clean even it it already exists, |
+# so we can do it every time we start up. I believe the fancy word is |
+# 'idempotent'. We do this before grabbing a lockfile because it should |
+# never screw anything up, even if run multiple times at once, and our |
+# lockfile may be (probably is, in fact) in one of these places. |
+ |
+if (!Create_Tree()) { |
+ my($msg) = "Couldn't create directory tree: $DebPool::Dirs::Error"; |
+ Log_Message($msg, LOG_GENERAL, LOG_FATAL); |
+ die "$msg\n"; |
+} |
+ |
+# Obtain a lockfile. We should never run more than one occurance; it's too |
+# likely that we'd step on our own toes. |
+ |
+if (!sysopen(LOCK_FILE, $Options{'lock_file'}, O_WRONLY|O_CREAT|O_EXCL, 0644)) { |
+ my($msg) = "Couldn't obtain lockfile '$Options{'lock_file'}'; "; |
+ |
+ if (open(LOCK_FILE, '<', $Options{'lock_file'}) && |
+ (my($pid) = <LOCK_FILE>)) { |
+ chomp($pid); |
+ $msg .= "(PID $pid)\n"; |
+ } else { |
+ $msg .= "(unable to read PID)\n"; |
+ } |
+ |
+ die $msg; |
+} else { # Do something useful - like put our PID into the file. |
+ print LOCK_FILE "$$\n"; |
+ close(LOCK_FILE); |
+} |
+ |
+# Start the main loop. We use a do/until loop so that we always fire off at |
+# least once. |
+ |
+MAIN_LOOP: do { |
+ |
+Log_Message("Starting processing run", LOG_GENERAL, LOG_DEBUG); |
+ |
+# First off, open up our databases. We do this each time through the loop, |
+# so that they get flushed periodically if we're in daemon mode. |
+ |
+Open_Databases(); |
+ |
+# This keeps track of what distributions need to have their Packages and |
+# Sources files rebuilt. We force it to be 'everything' if the user has |
+# requested a rebuild (normally from the command line). |
+ |
+my(%rebuild) = (); |
+ |
+if ($Options{'rebuild-files'}) { |
+ my($dist); |
+ foreach $dist (@{$Options{'realdists'}}) { |
+ $rebuild{$dist} = 1; |
+ } |
+} |
+ |
+# Check for any changes files in the incoming directory. |
+ |
+my(@changefiles) = Scan_Changes($Options{'incoming_dir'}); |
+ |
+# Go through each of the changes files we found, and process it. This is the |
+# heart of things. |
+ |
+my($changefile); |
+ |
+foreach $changefile (@changefiles) { |
+ Log_Message("Processing changefile '$changefile'", LOG_GENERAL, LOG_INFO); |
+ |
+ # .dsc = .changes, minus the part after the last _, plus .dsc |
+ |
+ my(@parts) = split(/_/, $changefile); |
+ pop(@parts); |
+ my($dscfile) = join('_', @parts) . '.dsc'; |
+ |
+ my($changes_data) = Parse_Changes("$Options{'incoming_dir'}/$changefile"); |
+ if (!defined($changes_data)) { |
+ Log_Message("Failure parsing changes file '$changefile': " . |
+ $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
+ next; |
+ } |
+ |
+ my($with_source) = undef; # Upload with or without source? |
+ my($temp); |
+ |
+ for $temp (@{$changes_data->{'Architecture'}}) { |
+ if ('source' eq $temp) { |
+ $with_source = 1; |
+ } |
+ } |
+ |
+ my($has_orig) = undef; # Has an orig tarball? |
+ my($filehr); |
+ |
+ foreach $filehr (@{$changes_data->{'Files'}}) { |
+ if ($filehr->{'Filename'} =~ /orig\.tar\.gz/) { |
+ $has_orig = 1; |
+ } |
+ } |
+ |
+ my($dsc_data) = Parse_DSC("$Options{'incoming_dir'}/$dscfile"); |
+ if ($with_source && !defined($dsc_data)) { |
+ Log_Message("Failure parsing dsc file '$dscfile': " . |
+ $DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR); |
+ next; |
+ } |
+ |
+ my($package) = $changes_data->{'Source'}; |
+ my($version) = $changes_data->{'Version'}; |
+ |
+ if ($Options{'require_sigs'}) { |
+ # First, check the changefile signature |
+ |
+ if (!Check_Signature("$Options{'incoming_dir'}/$changefile")) { |
+ Reject_Package($changefile, $changes_data); |
+ Log_Message("GPG signature failure in changes file '$changefile'", |
+ LOG_REJECT, LOG_ERROR); |
+ next; |
+ } else { |
+ Log_Message("Successful changes signature: '$changefile'", |
+ LOG_GPG, LOG_DEBUG); |
+ } |
+ |
+ # Now check the dscfile signature |
+ |
+ if ($with_source && !Check_Signature("$Options{'incoming_dir'}/$dscfile")) { |
+ Reject_Package($changefile, $changes_data); |
+ Log_Message("GPG signature failure in dsc file '$dscfile'", |
+ LOG_REJECT, LOG_ERROR); |
+ next; |
+ } else { |
+ Log_Message("Successful dsc signature: '$dscfile'", |
+ LOG_GPG, LOG_DEBUG); |
+ } |
+ } |
+ |
+ # Verify MD5 checksums on all files. |
+ |
+ my($valid) = 1; |
+ |
+ foreach $filehr (@{$changes_data->{'Files'}}) { |
+ if (!(Verify_MD5("$Options{'incoming_dir'}/$filehr->{'Filename'}", |
+ $filehr->{'MD5Sum'}))) { |
+ $valid = undef; |
+ } |
+ } |
+ |
+ if (!$valid) { |
+ Reject_Package($changefile, $changes_data); |
+ |
+ my($msg) = "MD5 checksum failure in changes file '$changefile'"; |
+ Log_Message($msg, LOG_REJECT, LOG_ERROR); |
+ next; |
+ } |
+ |
+ $valid = 1; |
+ my($rejected) = undef; |
+ |
+ if ($with_source) { |
+ foreach $filehr (@{$dsc_data->{'Files'}}) { |
+ # A bit of a special case here; if the Changes file lists an |
+ # orig tarball, we must *not* have one for that version in the |
+ # pool. If it doesn't, then we *must* have one. In either case, |
+ # as long as it's in the right place we use that file for the |
+ # MD5Sum check when the file is listed in the DSC. |
+ |
+ my($file) = $filehr->{'Filename'}; |
+ |
+ if ($file =~ /orig\.tar\.gz/) { |
+ my($section) = Guess_Section($changes_data); |
+ my($pkg_pooldir) = join('/', |
+ ($Options{'pool_dir'}, PoolDir($package, $section), |
+ $package)); |
+ |
+ if ($has_orig) { # Orig tarball uploaded |
+ if (-e "$pkg_pooldir/$file") { |
+ Reject_Package($changefile, $changes_data); |
+ |
+ my($msg) = "Duplicate orig tarball '$file'"; |
+ Log_Message($msg, LOG_REJECT, LOG_ERROR); |
+ |
+ $rejected = 1; |
+ last; # Don't check other files, we just rejected |
+ } elsif (!(-e "$Options{'incoming_dir'}/$file")) { |
+ Reject_Package($changefile, $changes_data); |
+ |
+ my($msg) = "Missing orig tarball '$file'"; |
+ Log_Message($msg, LOG_REJECT, LOG_ERROR); |
+ |
+ $rejected = 1; |
+ last; # Don't check other files, we just rejected |
+ } else { |
+ $file = "$Options{'incoming_dir'}/$file"; |
+ } |
+ } else { # Orig tarball in pool - we hope |
+ if (!(-e "$pkg_pooldir/$file")) { |
+ Reject_Package($changefile, $changes_data); |
+ |
+ my($msg) = "Missing orig tarball '$file'"; |
+ Log_Message($msg, LOG_REJECT, LOG_ERROR); |
+ |
+ $rejected = 1; |
+ last; # Don't check other files, we just rejected |
+ } else { |
+ $file = "$pkg_pooldir/$file"; |
+ } |
+ } |
+ } else { # Not an orig tarball - must be in upload |
+ $file = "$Options{'incoming_dir'}/$file"; |
+ } |
+ |
+ # Whatever it is, it must also pass the MD5 checksum test. |
+ |
+ if (!(Verify_MD5($file, $filehr->{'MD5Sum'}))) { |
+ $valid = undef; |
+ last; # Don't check other files, we already failed |
+ } |
+ } |
+ } |
+ |
+ next if ($rejected); # Reject message already logged, go to next package. |
+ |
+ if (!$valid) { |
+ Reject_Package($changefile, $changes_data); |
+ |
+ my($msg) = "MD5 checksum failure in dsc file '$dscfile'"; |
+ Log_Message($msg, LOG_REJECT, LOG_ERROR); |
+ next; |
+ } |
+ |
+ # Go through each distribution in the changes file, and decide whether |
+ # the package is valid for that distribution. |
+ |
+ my($distribution, $realdist); |
+ my(@valid_dists); |
+ |
+ foreach $distribution (@{$changes_data->{'Distribution'}}) { |
+ $realdist = $distribution; |
+ |
+ if (defined($Options{'virtual_dists'}->{$realdist})) { |
+ $realdist = $Options{'virtual_dists'}->{$realdist}; |
+ } |
+ |
+ if (defined($Options{'dists'}->{$realdist})) { |
+ $realdist = $Options{'dists'}->{$realdist}; |
+ } |
+ |
+ if (!defined($realdist)) { |
+ Log_Message("Distribution $distribution does not exist", |
+ LOG_INSTALL, LOG_ERROR); |
+ next; |
+ } |
+ |
+ my($allow) = Allow_Version($package, $version, $realdist); |
+ |
+ if (!defined($allow)) { |
+ Log_Message("Version check for $version failed: " . |
+ $DebPool::Packages::Error, LOG_INSTALL, LOG_ERROR); |
+ next; |
+ } |
+ |
+ if (!$allow) { |
+ Log_Message("Cannot install version $version of $package to " . |
+ "$realdist", LOG_INSTALL, LOG_WARNING); |
+ next; |
+ } |
+ |
+ # It's valid. Put it in the list. |
+ |
+ push(@valid_dists, $realdist); |
+ } |
+ |
+ if (-1 == $#valid_dists) { |
+ Reject_Package($changefile, $changes_data); |
+ Log_Message("No valid distributions for version $version of $package", |
+ LOG_REJECT, LOG_ERROR); |
+ next; |
+ } |
+ |
+ # Install the package |
+ |
+ if (Install_Package($changefile, $changes_data, $dscfile, $dsc_data, \@valid_dists)) { |
+ my($dist); |
+ foreach $dist (@valid_dists) { |
+ $rebuild{$dist} = 1; |
+ } |
+ |
+ my($msg) = "Installed $package ($version) to "; |
+ $msg .= "distribution(s): " . join(', ', @valid_dists); |
+ Log_Message($msg, LOG_INSTALL, LOG_INFO); |
+ } else { |
+ # Something is very, very wrong. |
+ Log_Message("Couldn't install package '$package': " . |
+ $DebPool::Packages::Error, LOG_INSTALL, LOG_FATAL); |
+ Close_Databases(); |
+ unlink($Options{'lock_file'}); # Release our lock |
+ die "Couldn't install package '$package'\n"; |
+ } |
+ |
+ # And, now that that's done, audit the package area in the pool to get |
+ # rid of crufty, obsolete versions. |
+ |
+ Audit_Package($package, $changes_data); |
+} |
+ |
+# Regenerate {Packages,Sources}{,.gz} for distributions which need it. Also |
+# rebuild Release files that need it, if we're doing them. |
+ |
+my($dist, $section); |
+ |
+foreach $dist (keys(%rebuild)) { |
+ my(@rel_filelist) = (); |
+ foreach $section (@{$Options{'sections'}}) { |
+ my(@archs) = @{$Options{'archs'}}; |
+ @archs = grep(!/^all$/, @archs); # We don't build binary-all files. |
+ |
+ my($arch); |
+ |
+ARCH_LOOP: |
+ foreach $arch (@{$Options{'archs'}}) { |
+ # We cheat, and use @triple for dist/section/arch inputs. |
+ # Perl lets us get away with this. I'd care, except that Perl |
+ # prototyping isn't, so it's useless to not do this. |
+ |
+ my(@triple) = ($dist, $section, $arch); |
+ |
+ # Generate a Packages/Sources file. |
+ |
+ my($file) = Generate_List(@triple); |
+ |
+ if (!defined($file)) { |
+ my($msg) = "Couldn't create list for $dist/$section/${arch}: "; |
+ $msg .= $DebPool::Packages::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ next; |
+ } |
+ |
+ # If we're compressing distribution files, do that here. |
+ |
+ my($gzfile); |
+ if ($Options{'compress_dists'}) { |
+ $gzfile = Gzip_File($file); |
+ |
+ if (!defined($gzfile)) { |
+ my($msg) = "Couldn't create compressed file: "; |
+ $msg .= $DebPool::Gzip::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ unlink($file); |
+ next; |
+ } |
+ } |
+ |
+ # If we're doing Release files, now is the time for triples. |
+ |
+ my($relfile); |
+ my($sigfile); |
+ |
+ if ($Options{'do_release'}) { |
+ require DebPool::Release; |
+ |
+ # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
+ |
+ my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
+ $relfile = DebPool::Release::Generate_Release_Triple( |
+ @triple, $release_version); |
+ |
+ if (!defined($relfile)) { |
+ my($msg) = "Couldn't create Release file: "; |
+ $msg .= $DebPool::Release::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ unlink($file); |
+ if (defined($gzfile)) { |
+ unlink($gzfile); |
+ } |
+ next; |
+ } |
+ |
+ if ($Options{'sign_release'}) { |
+ $sigfile = Sign_Release($relfile); |
+ |
+ if (!defined($sigfile)) { |
+ my($msg) = "Couldn't create Release signature file: "; |
+ $msg .= $DebPool::GnuPG::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ unlink($file); |
+ |
+ if (defined($gzfile)) { |
+ unlink($gzfile); |
+ } |
+ |
+ if (defined($relfile)) { |
+ unlink($relfile); |
+ } |
+ |
+ next; |
+ } |
+ } |
+ } |
+ |
+ # Install {Packages,Sources}{,.gz} |
+ |
+ if (!Install_List(@triple, $file, $gzfile)) { |
+ |
+ my($msg) = "Couldn't install distribution files for "; |
+ $msg .= "$dist/$section/${arch}: " . $DebPool::Packages::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ if (-e $file) { |
+ unlink($file); |
+ } |
+ |
+ if (defined($gzfile) && -e $gzfile) { |
+ unlink($gzfile); |
+ } |
+ |
+ if (defined($relfile) && -e $relfile) { |
+ unlink($relfile); |
+ } |
+ |
+ if (defined($sigfile) && -e $sigfile) { |
+ unlink($sigfile); |
+ } |
+ |
+ next; |
+ } |
+ |
+ # Install Release{,.gpg} |
+ |
+ if (defined($relfile) && |
+ !DebPool::Release::Install_Release(@triple, $relfile, $sigfile)) { |
+ |
+ my($msg) = "Couldn't install release files for "; |
+ $msg .= "$dist/$section/${arch}: " . $DebPool::Release::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ if (-e $relfile) { |
+ unlink($relfile); |
+ } |
+ |
+ if (defined($sigfile) && -e $sigfile) { |
+ unlink($sigfile); |
+ } |
+ |
+ next; |
+ } |
+ |
+ my($pushfile) = Archfile(@triple, 0); |
+ $pushfile =~ s/${dist}\///; |
+ push(@rel_filelist, $pushfile); |
+ |
+ if (defined($gzfile)) { |
+ push(@rel_filelist, $pushfile . '.gz'); |
+ } |
+ |
+ if (defined($relfile)) { |
+ $pushfile = Archfile(@triple, 1); |
+ $pushfile =~ s/${dist}\///; |
+ $pushfile .= '/Release'; |
+ push(@rel_filelist, $pushfile); |
+ |
+ if (defined($sigfile)) { |
+ push(@rel_filelist, $pushfile . '.gpg'); |
+ } |
+ } |
+ } |
+ } |
+ |
+ # If we're doing Release files, now is the time for the general dist one. |
+ |
+ my($relfile); |
+ my($sigfile); |
+ |
+ if ($Options{'do_release'}) { |
+ require DebPool::Release; |
+ |
+ # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default. |
+ |
+ my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime()); |
+ $relfile = DebPool::Release::Generate_Release_Dist( |
+ $dist, $release_version, @rel_filelist); |
+ |
+ if (!defined($relfile)) { |
+ my($msg) = "Couldn't create Release file: "; |
+ $msg .= $DebPool::Release::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ } else { |
+ if ($Options{'sign_release'}) { |
+ $sigfile = Sign_Release($relfile); |
+ |
+ if (!defined($sigfile)) { |
+ my($msg) = "Couldn't create Release signature file: "; |
+ $msg .= $DebPool::GnuPG::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ unlink($relfile); |
+ $relfile = undef; |
+ } |
+ } |
+ } |
+ } |
+ |
+ # Install Release{,.gpg} |
+ |
+ if (defined($relfile) && |
+ !DebPool::Release::Install_Release($dist, undef, undef, |
+ $relfile, $sigfile)) { |
+ my($msg) = "Couldn't install release files for "; |
+ $msg .= "${dist}: " . $DebPool::Release::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ |
+ if (-e $relfile) { |
+ unlink($relfile); |
+ } |
+ |
+ if (defined($sigfile) && -e $sigfile) { |
+ unlink($sigfile); |
+ } |
+ } |
+} |
+ |
+# Close out the databases, ensuring that they're flushed to disk. We'll |
+# just reopen them in a moment, if we're in daemon mode; it's still good to |
+# write them out. |
+ |
+Close_Databases(); |
+ |
+# This will short-circuit if we catch a signal while sleeping. |
+ |
+if ($Options{'daemon'}) { |
+ Log_Message("Waiting on changes to incoming dir.", LOG_GENERAL, LOG_DEBUG); |
+ |
+ if (!Monitor_Incoming()) { |
+ my($msg) = "Error in Monitor_Incoming: " . $DebPool::Dirs::Error; |
+ Log_Message($msg, LOG_GENERAL, LOG_ERROR); |
+ } |
+} |
+ |
+# End of MAIN_LOOP; we loop back until either we're not in daemon mode |
+# (that is, we've been told to single-pass), or until we catch a signal. |
+ |
+} until ((!$Options{'daemon'}) || $Signal_Caught); |
+ |
+# Release our lock |
+ |
+unlink($Options{'lock_file'}); |
+ |
+Log_Message("Exiting.", LOG_GENERAL, LOG_DEBUG); |
+ |
+exit(0); |
+ |
+__END__ |
+ |
+# vim:set tabstop=4 expandtab: |
/trunk/bin/debpool |
---|
Property changes: |
Added: svn:executable |
Index: trunk/man/man5/DebPool::Config.5 |
=================================================================== |
--- trunk/man/man5/DebPool::Config.5 (nonexistent) |
+++ trunk/man/man5/DebPool::Config.5 (revision 3) |
@@ -0,0 +1,531 @@ |
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.14 |
+.\" |
+.\" Standard preamble: |
+.\" ======================================================================== |
+.de Sh \" Subsection heading |
+.br |
+.if t .Sp |
+.ne 5 |
+.PP |
+\fB\\$1\fR |
+.PP |
+.. |
+.de Sp \" Vertical space (when we can't use .PP) |
+.if t .sp .5v |
+.if n .sp |
+.. |
+.de Vb \" Begin verbatim text |
+.ft CW |
+.nf |
+.ne \\$1 |
+.. |
+.de Ve \" End verbatim text |
+.ft R |
+.fi |
+.. |
+.\" Set up some character translations and predefined strings. \*(-- will |
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left |
+.\" double quote, and \*(R" will give a right double quote. | will give a |
+.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to |
+.\" do unbreakable dashes and therefore won't be available. \*(C` and \*(C' |
+.\" expand to `' in nroff, nothing in troff, for use with C<>. |
+.tr \(*W-|\(bv\*(Tr |
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' |
+.ie n \{\ |
+. ds -- \(*W- |
+. ds PI pi |
+. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch |
+. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch |
+. ds L" "" |
+. ds R" "" |
+. ds C` "" |
+. ds C' "" |
+'br\} |
+.el\{\ |
+. ds -- \|\(em\| |
+. ds PI \(*p |
+. ds L" `` |
+. ds R" '' |
+'br\} |
+.\" |
+.\" If the F register is turned on, we'll generate index entries on stderr for |
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index |
+.\" entries marked with X<> in POD. Of course, you'll have to process the |
+.\" output yourself in some meaningful fashion. |
+.if \nF \{\ |
+. de IX |
+. tm Index:\\$1\t\\n%\t"\\$2" |
+.. |
+. nr % 0 |
+. rr F |
+.\} |
+.\" |
+.\" For nroff, turn off justification. Always turn off hyphenation; it makes |
+.\" way too many mistakes in technical documents. |
+.hy 0 |
+.if n .na |
+.\" |
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). |
+.\" Fear. Run. Save yourself. No user-serviceable parts. |
+. \" fudge factors for nroff and troff |
+.if n \{\ |
+. ds #H 0 |
+. ds #V .8m |
+. ds #F .3m |
+. ds #[ \f1 |
+. ds #] \fP |
+.\} |
+.if t \{\ |
+. ds #H ((1u-(\\\\n(.fu%2u))*.13m) |
+. ds #V .6m |
+. ds #F 0 |
+. ds #[ \& |
+. ds #] \& |
+.\} |
+. \" simple accents for nroff and troff |
+.if n \{\ |
+. ds ' \& |
+. ds ` \& |
+. ds ^ \& |
+. ds , \& |
+. ds ~ ~ |
+. ds / |
+.\} |
+.if t \{\ |
+. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" |
+. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' |
+. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' |
+. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' |
+. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' |
+. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' |
+.\} |
+. \" troff and (daisy-wheel) nroff accents |
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' |
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H' |
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] |
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' |
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' |
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] |
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] |
+.ds ae a\h'-(\w'a'u*4/10)'e |
+.ds Ae A\h'-(\w'A'u*4/10)'E |
+. \" corrections for vroff |
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' |
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' |
+. \" for low resolution devices (crt and lpr) |
+.if \n(.H>23 .if \n(.V>19 \ |
+\{\ |
+. ds : e |
+. ds 8 ss |
+. ds o a |
+. ds d- d\h'-1'\(ga |
+. ds D- D\h'-1'\(hy |
+. ds th \o'bp' |
+. ds Th \o'LP' |
+. ds ae ae |
+. ds Ae AE |
+.\} |
+.rm #[ #] #H #V #F C |
+.\" ======================================================================== |
+.\" |
+.IX Title "DebPool::Config 5" |
+.TH DebPool::Config 5 "2005-01-20" "perl v5.8.4" "DebPool Configuration" |
+.SH "NAME" |
+DebPool::Config \- configuration file format for debpool |
+.SH "SYNOPSIS" |
+.IX Header "SYNOPSIS" |
+package DebPool::Config; |
+.PP |
+%Options = ( |
+ 'option1' => value1, |
+ 'option2' => value2, |
+ ... |
+); |
+.PP |
+1; |
+.SH "DESCRIPTION" |
+.IX Header "DESCRIPTION" |
+The DebPool::Config file is normally found in three places; |
+\&\fI/usr/share/debpool/Config.pm\fR, \fI/etc/debpool/Config.pm\fR, and |
+\&\fI$HOME/.debpool/Config.pm\fR (in ascending order of precedence); |
+further locations can also be specified on the command line with the |
+\&'\-\-config=<file>' option, which overrides all of these (and is, in turn, |
+overridden by any command line options). Also of note is the \-\-nodefault |
+option, which prevents any attempt at loading the default (system and user) |
+config files. |
+.PP |
+The config files in /etc/debpool and \f(CW$HOME\fR/.debpool are not required to be |
+full Perl modules, though they must still declare a package namespace of |
+\&'DebPool::Config' and return a true value. |
+.Sh "File/Directory configuration" |
+.IX Subsection "File/Directory configuration" |
+These config values determine what directories various parts of the archive |
+are put in, and what permissions those directories have, as well as the |
+default permissions for files. |
+.PP |
+\&\s-1NOTE:\s0 While debpool will attempt to create db_dir, dists_dir, incoming_dir, |
+installed_dir, pool_dir, and reject_dir if they do not exist, it will *not* |
+attempt to do this for archive_dir. |
+.PP |
+\&\s-1WARNING:\s0 If you redefine archive_dir and you want the other four entries to |
+reflect this by incorporating the new value, you *MUST* redefine them here |
+(even if you simply use the default value of 'archive_dir'/<dirname>) so |
+that they use the new definition of archive_dir. |
+.IP "\fBarchive_dir\fR => \fIarchive directory\fR" 4 |
+.IX Item "archive_dir => archive directory" |
+Base directory of the archive. This is never used directly; however, it |
+is normally used to construct relative paths for dists_dir, incoming_dir, |
+installed_dir, pool_dir, and reject_dir. |
+.Sp |
+\&\s-1WARNING:\s0 See the section documentation for important details about |
+redefining this value. |
+.Sp |
+Default value: '/var/cache/debpool' |
+.IP "\fBdb_dir\fR => \fIdists directory\fR" 4 |
+.IX Item "db_dir => dists directory" |
+\&\s-1DB\s0 directory, where the database files for each distribution are kept. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/db\*(R" |
+.IP "\fBdb_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "db_dir_mode = permissions (octal)" |
+Permissions for db_dir. |
+.Sp |
+Default value: 0750 |
+.IP "\fBdb_file_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "db_file_mode = permissions (octal)" |
+Permissions for database files in db_dir. |
+.Sp |
+Default value: 0640 |
+.IP "\fBdists_dir\fR => \fIdists directory\fR" 4 |
+.IX Item "dists_dir => dists directory" |
+Dists directory, where distribution files (\fI{Packages,Sources}{,.gz}\fR live. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/dists\*(R" |
+.IP "\fBdists_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "dists_dir_mode = permissions (octal)" |
+Permissions for dists_dir and all of it's subdirectories. |
+.Sp |
+Default value: 0755 |
+.IP "\fBdists_file_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "dists_file_mode = permissions (octal)" |
+Permissions for distribution files ({Packages,Sources}{,.gz}. |
+.Sp |
+Default value: 0644 |
+.IP "\fBincoming_dir\fR => \fIincoming directory\fR" 4 |
+.IX Item "incoming_dir => incoming directory" |
+Incoming directory, where new packages are uploaded. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/incoming\*(R"; |
+.IP "\fBincoming_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "incoming_dir_mode = permissions (octal)" |
+Permissions for incoming_dir. Should have the sticky bit set if you want a |
+system archive. |
+.Sp |
+Default value: 01775 |
+.IP "\fBinstalled_dir\fR => \fIinstalled directory\fR" 4 |
+.IX Item "installed_dir => installed directory" |
+Incoming directory, where new packages are uploaded. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/installed\*(R"; |
+.IP "\fBinstalled_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "installed_dir_mode = permissions (octal)" |
+Permissions for installed_dir. Should have the sticky bit set if you want a |
+system archive. |
+.Sp |
+Default value: 0755 |
+.IP "\fBinstalled_file_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "installed_file_mode = permissions (octal)" |
+Permissions for installed Changes files. |
+.Sp |
+Default value: 0644 |
+.IP "\fBpool_dir\fR => \fIpool directory\fR" 4 |
+.IX Item "pool_dir => pool directory" |
+Pool directory where all .deb files are stored after being accepted. Normally |
+this is constructed as a relative path from archive_dir. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/pool\*(R" |
+.IP "\fBpool_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "pool_dir_mode = permissions (octal)" |
+Permissions for pool_dir and all of it's subdirectories. |
+.Sp |
+Default value: 0755 |
+.IP "\fBpool_file_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "pool_file_mode = permissions (octal)" |
+Permissions for files installed into the pool area (orig.tar.gz, tar.gz, |
+diff.gz, dsc, deb). |
+.Sp |
+Default value: 0644 |
+.IP "\fBreject_dir\fR => \fIreject directory\fR" 4 |
+.IX Item "reject_dir => reject directory" |
+Reject directory, where rejected packages are placed. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/reject\*(R" |
+.IP "\fBreject_dir_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "reject_dir_mode = permissions (octal)" |
+Permissions for reject_dir. |
+.Sp |
+Default value: 0750 |
+.IP "\fBreject_file_mode\fR = \fIpermissions (octal)\fR" 4 |
+.IX Item "reject_file_mode = permissions (octal)" |
+Permissions for rejected package files. |
+.Sp |
+Default value: 0640 |
+.IP "\fBlock_file\fR => \fIlockfile\fR" 4 |
+.IX Item "lock_file => lockfile" |
+Location of the lockfile to use when running. |
+.Sp |
+Default value: \*(L"$Options{'archive_dir'}/.lock\*(R" |
+.IP "\fBcompress_dists\fR = \fIboolean\fR" 4 |
+.IX Item "compress_dists = boolean" |
+This determines whether or not compressed versions of the distribution |
+files (Packages.gz, Sources.gz) are generated. Note that enabling this |
+introduces a dependancy on gzip. |
+.Sh "Archive configuration" |
+.IX Subsection "Archive configuration" |
+These values control which distributions, components, and architectures the |
+archive will support. |
+.IP "\fBdists\fR => \fIhash of distribution names and codenames\fR" 4 |
+.IX Item "dists => hash of distribution names and codenames" |
+A hashref pointing to a hash with entries for all distributions we will |
+accept packages for, and what the current codename for each distribution |
+is. Note that it is acceptable for more than one distribution to point to a |
+given codename (for example, when frozen is active); however, this has some |
+strange (and non\-deterministic) consequences for Release files. |
+.Sp |
+Default value: |
+.Sp |
+{ 'stable' => 'woody', |
+ 'testing' => 'sarge', |
+ 'unstable' => 'sid', |
+ 'experimental' => 'experimental' } |
+.IP "\fBvirtual_dists\fR => \fIhash of virtual distribution names and targets\fR" 4 |
+.IX Item "virtual_dists => hash of virtual distribution names and targets" |
+A hashref pointing to a hash with entries for all 'virtual' distributions |
+we will accept packages for, and what distribution it should be treated |
+as. It is acceptable for more than one virtual distribution to point to a |
+given target. Note that unlike 'dists' entries, symlinks pointing from the |
+virtual name to the real name will not be created, and no attempt is made |
+to use these names in reverse processes (such as Release files); however, |
+virtual distributions may target any name (\*(L"unstable\*(R") or codename (\*(L"sid\*(R") |
+which appears in the 'dists' hash. |
+.Sp |
+Default value: |
+.Sp |
+{ |
+} |
+.Sp |
+Exsample value: |
+.Sp |
+{ 'unstable\-hostname' => 'unstable', |
+ 'testing\-hostname' => 'sarge', |
+} |
+.IP "\fBsections\fR => \fIarray of section names\fR" 4 |
+.IX Item "sections => array of section names" |
+An arrayref pointing to an array which lists all sections we will accept |
+packages for. Typically, these will be drawn from the set 'main', |
+\&'contrib', 'non\-free', 'experimental', 'alien', and 'local' (at least on |
+the author's systems). |
+.Sp |
+Default value: [ 'main', 'contrib', 'non\-free' ] |
+.IP "\fBarchs\fR => \fIarray of architecture names\fR" 4 |
+.IX Item "archs => array of architecture names" |
+An arrayref pointing to an array which lists all architectures we will |
+accept packages for. Note that 'source' will always be present, and 'all' |
+will be silently ignored (uploads for Arch: all will still work, but the |
+listings appear in arch-specific Packages files). |
+.Sp |
+Default value: [ 'i386' ] |
+.Sh "Release configuration" |
+.IX Subsection "Release configuration" |
+If all of the variables below are defined (release_origin, release_label, |
+and release_description), Release files will be generated for each |
+distribution directory. |
+.PP |
+Please note that enabling Release files will introduce a dependancy on the |
+packages 'libdigest\-md5\-perl' and 'libdigest\-sha1\-perl'. |
+.PP |
+See also: sign_release |
+.IP "\fBrelease_origin\fR => \fIorigin tag\fR" 4 |
+.IX Item "release_origin => origin tag" |
+A string to be used for the Origin tag in the Release file. |
+.Sp |
+Default value: undef |
+.IP "\fBrelease_label\fR => \fIlabel tag\fR" 4 |
+.IX Item "release_label => label tag" |
+A string to be used for the Label tag in the Release file. |
+.Sp |
+Default value: undef |
+.IP "\fBrelease_description\fR => \fIdescription tag\fR" 4 |
+.IX Item "release_description => description tag" |
+A string to be used for the Description tag in the Release file. (Note that |
+this should be a single line.) |
+.Sp |
+Default value: undef |
+.IP "\fBrelease_noauto\fR = <array of NonAutomatic release names>" 4 |
+.IX Item "release_noauto = <array of NonAutomatic release names>" |
+An array of release names which should be tagged with 'NonAutomatic: yes' |
+in their Release files. This tag will keep \s-1APT\s0 from ever automatically |
+selecting a package from that archive as an installation candidate. |
+.Sp |
+Default value: [ 'experimental' ] |
+.Sh "Signature configuration" |
+.IX Subsection "Signature configuration" |
+Please note that enabling any of these options will cause a dependancy on |
+the 'gnupg' package. See \fI/usr/share/doc/debpool/README.GnuPG\fR for more |
+information. |
+.IP "\fBrequire_sigs_debs\fR = \fIboolean\fR" 4 |
+.IX Item "require_sigs_debs = boolean" |
+If true, packages will be rejected unless their package files (.deb) |
+are GPG-signed with a recognized key found one of the keyrings listed |
+in 'gpg_keyrings'. These can be signed with the tools in the 'debsigs' |
+package. |
+.Sp |
+Default value: 0 (false) |
+.Sp |
+See also: gpg_keyrings |
+.IP "\fBrequire_sigs_meta\fR = \fIboolean\fR" 4 |
+.IX Item "require_sigs_meta = boolean" |
+If true, packages will be rejected unless their meta-files (.changes and |
+\&.dsc) are GPG-signed with a recognized key found one of the keyrings listed |
+in 'gpg_keyrings'. These are the files normally signed by the 'debsign' |
+utility in devscripts package. |
+.Sp |
+Default value: 0 (false) |
+.Sp |
+See also: gpg_keyrings |
+.IP "\fBsign_release\fR = \fIboolean\fR" 4 |
+.IX Item "sign_release = boolean" |
+If true, generated Release files with be GPG-signed with the key specified |
+in 'gpg_sign_key'. |
+.Sp |
+Note that this will have no effect unless 'gpg_sign_key' is also defined at |
+some point. |
+.Sp |
+Default value: 0 (false) |
+.Sp |
+See also: \*(L"Release configuration\*(R", gpg_sign_key |
+.Sh "GnuPG configuration" |
+.IX Subsection "GnuPG configuration" |
+These values will only be used if the use of GnuPG is triggered in some |
+fashion (such as any of the values in \*(L"Signature configuration\*(R" being |
+enabled) , and thus do not (in themselves) trigger a dependancy on GnuPG. |
+Please see \fI/usr/share/doc/debpool/README.GnuPG\fR for more information. |
+.IP "\fBgpg_bin\fR = \fIGnuPG binary\fR" 4 |
+.IX Item "gpg_bin = GnuPG binary" |
+This is used to specify the GnuPG binary to run. |
+.Sp |
+Default value: '/usr/bin/gpg' |
+.IP "\fBgpg_home\fR = \fIGnuPG homedir\fR" 4 |
+.IX Item "gpg_home = GnuPG homedir" |
+This is used to specify the GnuPG homedir (via the \-\-homedir option). |
+.Sp |
+Default value: '/home/user/.gnupg' |
+.IP "\fBgpg_keyrings\fR = \fIarray of keyring filenames\fR" 4 |
+.IX Item "gpg_keyrings = array of keyring filenames" |
+An arrayref pointing to an array which lists all of the \s-1GPG\s0 keyrings that |
+hold keys for approved uploaders. Note that this will have no effect unless |
+at least one of 'require_sigs_debs' or 'require_sigs_meta' is enabled. |
+.Sp |
+Default value: [ 'uploaders.gpg' ] |
+.Sp |
+See also: require_sigs_debs, require_sigs_meta |
+.IP "\fBgpg_sign_key\fR = \fIsignature keyID\fR" 4 |
+.IX Item "gpg_sign_key = signature keyID" |
+A string which contains the \s-1ID\s0 of the key which we will sign Release files |
+with. Note that this will have no effect unless 'sign_release' is true. |
+.Sp |
+Default value: undef |
+.Sp |
+See also: sign_release |
+.IP "\fBgpg_passfile\fR = \fIpassphrase file\fR" 4 |
+.IX Item "gpg_passfile = passphrase file" |
+This specifies the name of the file from which we read the GnuPG passphrase |
+for the key listed in gpg_sign_key. Note that it will have no effect unless |
+\&'sign_release' is true and 'gpg_sign_key' is defined. |
+.Sp |
+Default value: '/home/user/.gnupg/passphrase'; |
+.Sp |
+See also: sign_release, gpg_sign_key |
+.Sh "Logging configuration" |
+.IX Subsection "Logging configuration" |
+These are values which control the logging system. |
+.IP "\fBlog_file\fR = \fIfilename\fR" 4 |
+.IX Item "log_file = filename" |
+If this option is defined, logging output will be sent to the filename |
+specified. Note that an undefined value is considered an explicit request |
+to log nothing. |
+.Sh "Misc. configuration" |
+.IX Subsection "Misc. configuration" |
+These are values which don't particularly fit into any of the other |
+sections. |
+.RS 4 |
+.IP "\fBdaemon\fR = \fIboolean\fR" 4 |
+.IX Item "daemon = boolean" |
+This determines whether debpool runs as a daemon (never exiting except on |
+fatal errors, rescanning the Incoming directory periodically), or on a |
+single-run basis. True values cause debpool to run as a daemon. |
+.Sp |
+Default value: 0 (false) |
+.IP "\fBsleep\fR = \fIdelay\fR" 4 |
+.IX Item "sleep = delay" |
+This option determines how long the daemon sleeps for, between each |
+processing run. Note that signals (such as \s-1SIGHUP\s0, \s-1SIGINT\s0, or \s-1SIGTERM\s0) |
+will force the daemon to wake up before this expires, so don't worry about |
+setting it too long. |
+.Sp |
+Default value: 300 (5 minutes) |
+.IP "\fBrollback\fR = \fIboolean\fR" 4 |
+.IX Item "rollback = boolean" |
+This determines whether older packages in the incoming queue are allowed |
+to replace newer versions already in the archive (roll back the archive |
+version). |
+.Sp |
+Default value: 0 (false) |
+.IP "\fBrebuild-files\fR = \fIboolean\fR" 4 |
+.IX Item "rebuild-files = boolean" |
+This option can be set in configfiles, but is more commonly used from the |
+commandline; if set, it forces all of the distribution files (Packages and |
+Sources) to be rebuilt, whether or not they need it. This should almost |
+never be used in conjunction with the daemon option. |
+.Sp |
+Default value: 0 (false) |
+.IP "\fBrebuild-dbs\fR = \fIboolean\fR" 4 |
+.IX Item "rebuild-dbs = boolean" |
+This option should not be set in configfiles, only used from the |
+commandline; if set, it forces all of the metadata files to be rebuilt from |
+scratch. It should, of course, also not be used with the daemon option. |
+.Sp |
+\&\s-1WARNING:\s0 This feature is not yet implemented, and will (silently) fail to |
+do anything, at this time. It will be implemented in a future version. |
+.Sp |
+Default value: 0 (false) |
+.IP "\fBrebuild-all\fR = \fIboolean\fR" 4 |
+.IX Item "rebuild-all = boolean" |
+This option should not be set in configfiles, only used from the |
+commandline; if set, it is equivalent to turning on all other rebuild |
+options (currently \-\-rebuild\-files and \-\-rebuild\-dbs). |
+.Sp |
+\&\s-1WARNING:\s0 This feature depends on rebuild\-dbs, which is not yet implemented; |
+only the \-\-rebuild\-files section will be triggered. |
+.Sp |
+Default value: 0 (false) |
+.IP "\fBconfig\fR = \fIconfigfile\fR" 4 |
+.IX Item "config = configfile" |
+This is a special option that should not be put into configfiles; it is |
+intended only for command-line use. It may be issued multiple times; each |
+time it is used, it will add the named config file to the list which |
+DebPool will load (later config files override earlier ones, in case of any |
+conflicts). |
+.Sp |
+Default value: N/A |
+.RE |
+.RS 4 |
+.SH "CAVEATS" |
+.IX Header "CAVEATS" |
+Command line options will override all Config.pm declarations. |
+.SH "SEE ALSO" |
+.IX Header "SEE ALSO" |
+\&\fIdebpool\fR\|(1) |
+.SH "AUTHOR" |
+.IX Header "AUTHOR" |
+Joel Baker <fenton@debian.org> |
Index: trunk/man/man1/debpool.1 |
=================================================================== |
--- trunk/man/man1/debpool.1 (nonexistent) |
+++ trunk/man/man1/debpool.1 (revision 3) |
@@ -0,0 +1,60 @@ |
+'\" t |
+.\" ** The above line should force tbl to be a preprocessor ** |
+.\" Man page for debpool |
+.\" |
+.\" Copyright 2003-2004 Joel Aelwyn |
+.\" |
+.\" $Id: debpool.1 27 2004-11-07 03:06:59Z joel $ |
+.\" |
+.TH debpool 1 "07 October 2003" "0.1.5" "Debian Pool Archive Manager" |
+.SH NAME |
+debpool \- pool-based Debian package archive manager |
+.SH SYNOPSIS |
+.\" The general command line |
+.B debpool |
+[\| |
+.I options |
+\|] |
+.SH DESCRIPTION |
+.B debpool |
+is a utility for managing pool-based archives of Debian packages. It |
+can be run by individual users, and/or under a dedicated system user |
+configuration. |
+.SH EXAMPLES |
+None |
+.SH OVERVIEW |
+None |
+.SH DEFAULTS |
+See the |
+.BR DebPool::Config(5) |
+manpage for details on configuration option defaults. |
+.SH OPTIONS |
+See the |
+.BR DebPool::Config(5) |
+manpage for details on all configuration options. |
+.SH "EXIT STATUS" |
+.TP |
+.B 0 |
+Successful program execution |
+.TP |
+.B 1 |
+Failure of any kind |
+.SH ENVIRONMENT |
+Nothing useful |
+.SH FILES |
+.TP |
+.I /usr/share/debpool/perl5/DebPool/Config.pm |
+Program (internal) defaults file. |
+.TP |
+.I /etc/debpool/Config.pm |
+System defaults file. |
+.TP |
+.I $HOME/.debpool/Config.pm |
+User defaults file. |
+.SH SEE ALSO |
+.BR DebPool::Config(5) |
+.SH BUGS |
+The entire manpage sucks, because the author hasn't taken the time |
+to make it look nicer, and most of the important information really |
+lives in the pod2man output for the configuration file (also known as |
+DebPool::Config(5)). |
Index: trunk/examples/Config.pm |
=================================================================== |
--- trunk/examples/Config.pm (nonexistent) |
+++ trunk/examples/Config.pm (revision 3) |
@@ -0,0 +1,125 @@ |
+# DebPool configuration file |
+ |
+package DebPool::Config; |
+ |
+# A DebPool::Config file is a well-formed Perl module; it declares a |
+# package namespace of 'DebPool::Config', contains a definition of exactly |
+# one hash named 'Options', and declares a true value at the end of the |
+# file. |
+ |
+# File/Directory configuration |
+# |
+# These config values determine what directories various parts of the |
+# archive are put in, and what permissions those directories have, as well |
+# as the default permissions for files. |
+# |
+# NOTE: While debpool will attempt to create db_dir, dists_dir, |
+# incoming_dir, installed_dir, pool_dir, and reject_dir if they do not |
+# exist, it will *not* attempt to do this for archive_dir. |
+# |
+# WARNING: If you redefine archive_dir and you want the other four |
+# entries to reflect this by incorporating the new value, you *MUST* |
+# redefine them here (even if you simply use the default value of |
+# 'archive_dir'/<dirname>) so that they use the new definition of |
+# archive_dir. |
+ |
+#$Options{'archive_dir'} = '/var/cache/debpool'; |
+#$Options{'db_dir'} = "$Options{'archive_dir'}/db"; |
+#$Options{'db_dir_mode'} = 0750; |
+#$Options{'db_file_mode'} = 0640; |
+#$Options{'dists_dir'} = "$Options{'archive_dir'}/dists"; |
+#$Options{'dists_dir_mode'} = 0755; |
+#$Options{'dists_file_mode'} = 0644; |
+#$Options{'incoming_dir'} = "$Options{'archive_dir'}/incoming"; |
+#$Options{'incoming_dir_mode'} = 01775; |
+#$Options{'installed_dir'} = "$Options{'archive_dir'}/installed"; |
+#$Options{'installed_dir_mode'} = 0755; |
+#$Options{'installed_file_mode'} = 0644; |
+#$Options{'pool_dir'} = "$Options{'archive_dir'}/pool"; |
+#$Options{'pool_dir_mode'} = 0755; |
+#$Options{'pool_file_mode'} = 0644; |
+#$Options{'reject_dir'} = "$Options{'archive_dir'}/reject"; |
+#$Options{'reject_dir_mode'} = 0750; |
+#$Options{'reject_file_mode'} = 0640; |
+#$Options{'lock_file'} = "$Options{'archive_dir'}/.lock"; |
+#$Options{'compress_dists'} = 0; |
+ |
+# Archive configuration |
+# |
+# These values control which distributions, components, and architectures |
+# the archive will support. |
+ |
+#$Options{'dists'} = { |
+# 'stable' => 'woody', |
+# 'testing' => 'sarge', |
+# 'unstable' => 'sid', |
+# 'experimental' => 'experimental' |
+#}; |
+ |
+#$Options{'virtual_dists'} = { |
+#}; |
+ |
+#$Options{'sections'} = [ 'main', 'contrib', 'non-free' ]; |
+#$Options{'archs'} = [ 'i386' ]; |
+ |
+# Release configuration |
+ |
+# If all of the variables below are defined (release_origin, release_label, |
+# and release_description), Release files will be generated for each |
+# distribution directory. |
+# |
+# Please note that enabling Release files will introduce a dependancy on |
+# the packages 'libdigest-md5-perl' and 'libdigest-sha1-perl'. |
+ |
+#$Options{'release_origin'} = undef; |
+#$Options{'release_label'} = undef; |
+#$Options{'release_description'} = undef; |
+ |
+#$Options{'release_noauto'} = [ |
+# 'experimental', |
+#]; |
+ |
+# Signature configuration |
+ |
+# Please note that enabling either of these options will cause a dependancy |
+# on the 'gnupg' package. See /usr/share/doc/debpool/README.GnuPG for more |
+# information. |
+ |
+#$Options{'require_sigs_debs'} = 0; |
+#$Options{'require_sigs_meta'} = 0; |
+#$Options{'sign_release'} = 0; |
+ |
+# GnuPG configuration |
+ |
+# These values will only be used if the use of GnuPG is triggered in some |
+# fashion (such as 'require_sigs' or 'sign_release' being true), and |
+# thus do not (in themselves) trigger a dependancy on GnuPG. Please see |
+# /usr/share/doc/debpool/README.GnuPG for more information. |
+ |
+#$Options{'gpg_bin'} = '/usr/bin/gpg'; |
+#$Options{'gpg_home'} = '/home/user/.gnupg'; |
+#$Options{'gpg_keyrings'} = [ 'uploaders.gpg' ]; |
+#$Options{'gpg_sign_key'} = undef; |
+#$Options{'gpg_passfile'} = '/home/user/.gnupg/passphrase'; |
+ |
+# Logging configuration |
+# |
+# These are values which control the logging system. |
+ |
+#$Options{'log_file'} = '/home/user/.debpool/DebPool.log'; |
+ |
+# Misc. configuration |
+ |
+# These are values which don't particularly fit into any of the other |
+# sections. |
+ |
+#$Options{'daemon'} = 0; |
+#$Options{'sleep'} = 300; |
+#$Options{'rollback'} = 0; |
+#$Options{'rebuild-files'} = 0; |
+#$Options{'rebuild-dbs'} = 0; |
+#$Options{'rebuild-all'} = 0; |
+ |
+# We're a module, so return a true value. |
+ |
+1; |