| /tags/0.2.3/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. |
| /tags/0.2.3/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. |
| /tags/0.2.3/debian/compat |
|---|
| 0,0 → 1,0 |
| 4 |
| /tags/0.2.3/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 |
| /tags/0.2.3/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 |
| /tags/0.2.3/debian/debpool.install |
|---|
| 0,0 → 1,3 |
| examples/Config.pm etc/debpool |
| bin/debpool usr/bin |
| share/DebPool usr/share/debpool/perl5 |
| /tags/0.2.3/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: tags/0.2.3/debian/debpool.examples |
| =================================================================== |
| --- tags/0.2.3/debian/debpool.examples (nonexistent) |
| +++ tags/0.2.3/debian/debpool.examples (revision 11) |
| @@ -0,0 +1 @@ |
| +examples/Config.pm |
| Index: tags/0.2.3/debian/README.Why |
| =================================================================== |
| --- tags/0.2.3/debian/README.Why (nonexistent) |
| +++ tags/0.2.3/debian/README.Why (revision 11) |
| @@ -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: tags/0.2.3/debian/TODO |
| =================================================================== |
| --- tags/0.2.3/debian/TODO (nonexistent) |
| +++ tags/0.2.3/debian/TODO (revision 11) |
| @@ -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: tags/0.2.3/debian/copyright |
| =================================================================== |
| --- tags/0.2.3/debian/copyright (nonexistent) |
| +++ tags/0.2.3/debian/copyright (revision 11) |
| @@ -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: tags/0.2.3/debian/README.User |
| =================================================================== |
| --- tags/0.2.3/debian/README.User (nonexistent) |
| +++ tags/0.2.3/debian/README.User (revision 11) |
| @@ -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: tags/0.2.3/debian/debpool.docs |
| =================================================================== |
| --- tags/0.2.3/debian/debpool.docs (nonexistent) |
| +++ tags/0.2.3/debian/debpool.docs (revision 11) |
| @@ -0,0 +1,3 @@ |
| +debian/README.GnuPG |
| +debian/README.User |
| +debian/README.Why |
| Index: tags/0.2.3/debian/README.GnuPG |
| =================================================================== |
| --- tags/0.2.3/debian/README.GnuPG (nonexistent) |
| +++ tags/0.2.3/debian/README.GnuPG (revision 11) |
| @@ -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: tags/0.2.3/debian/NEWS |
| =================================================================== |
| --- tags/0.2.3/debian/NEWS (nonexistent) |
| +++ tags/0.2.3/debian/NEWS (revision 11) |
| @@ -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: tags/0.2.3/debian/debpool.manpages |
| =================================================================== |
| --- tags/0.2.3/debian/debpool.manpages (nonexistent) |
| +++ tags/0.2.3/debian/debpool.manpages (revision 11) |
| @@ -0,0 +1 @@ |
| +man/man*/* |
| Index: tags/0.2.3/debian/README.Debian |
| =================================================================== |
| --- tags/0.2.3/debian/README.Debian (nonexistent) |
| +++ tags/0.2.3/debian/README.Debian (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Config.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Config.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Config.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/DB.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/DB.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/DB.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Logging.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Logging.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Logging.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Gzip.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Gzip.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Gzip.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Signal.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Signal.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Signal.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Util.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Util.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Util.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Packages.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Packages.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Packages.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/GnuPG.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/GnuPG.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/GnuPG.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Release.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Release.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Release.pm (revision 11) |
| @@ -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: tags/0.2.3/share/DebPool/Dirs.pm |
| =================================================================== |
| --- tags/0.2.3/share/DebPool/Dirs.pm (nonexistent) |
| +++ tags/0.2.3/share/DebPool/Dirs.pm (revision 11) |
| @@ -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: tags/0.2.3/bin/debpool |
| =================================================================== |
| --- tags/0.2.3/bin/debpool (nonexistent) |
| +++ tags/0.2.3/bin/debpool (revision 11) |
| @@ -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: |
| /tags/0.2.3/bin/debpool |
|---|
| Property changes: |
| Added: svn:executable |
| Index: tags/0.2.3/man/man5/DebPool::Config.5 |
| =================================================================== |
| --- tags/0.2.3/man/man5/DebPool::Config.5 (nonexistent) |
| +++ tags/0.2.3/man/man5/DebPool::Config.5 (revision 11) |
| @@ -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: tags/0.2.3/man/man1/debpool.1 |
| =================================================================== |
| --- tags/0.2.3/man/man1/debpool.1 (nonexistent) |
| +++ tags/0.2.3/man/man1/debpool.1 (revision 11) |
| @@ -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: tags/0.2.3/examples/Config.pm |
| =================================================================== |
| --- tags/0.2.3/examples/Config.pm (nonexistent) |
| +++ tags/0.2.3/examples/Config.pm (revision 11) |
| @@ -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; |