From c9a719faf41a73153897e7f83a3b5a1fe171620b Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 4 Dec 2006 10:01:35 -0600 Subject: [PATCH] Import version as of 2006-12-04 for upload-ftp-v1.1.pl --- upload-ftp-v1.1.pl | 1038 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1038 insertions(+) create mode 100755 upload-ftp-v1.1.pl diff --git a/upload-ftp-v1.1.pl b/upload-ftp-v1.1.pl new file mode 100755 index 0000000..068b1f9 --- /dev/null +++ b/upload-ftp-v1.1.pl @@ -0,0 +1,1038 @@ +#!/usr/local/bin/perl -Tw +# +# Take files that have been uploaded via ftp and move them into place on +# ftp.gnu.org. +# +# This file is free software; as a special exception the author gives +# unlimited permission to copy and/or distribute it, with or without +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +# We expect to find (1) a directive file, specifying the directory to +# store into (syntax details later); (2) the actual file to be +# distributed (no signature); (3) a detached signature for (2). +# +# For instance: +# foo-1.2.tar.gz.directive.asc, signed (gpg --clearsign) ASCII text +# about what to do with the other two files. +# foo-1.2.tar.gz, the file to upload (could be anything) with no sig. +# foo-1.2.tar.gz.sig, detached binary signature (gpg -b) for uploaded file. +# +# The directive file must always contain a 'directory', 'version' and +# 'filename' directive, unless when run in compatibility mode ($V1_COMPAT_MODE +# is set), in which case directive files with only a 'directory' directive are +# allowed. +# +# Alternatively, we expect to find only a directive file. This file must have +# a name that ends in 'directive.asc', and must contain one or more of these +# directives: 'symlink', 'rmsymlink' and 'archive', in addition to the obligatory +# 'directory' and 'version' directives. A 'filename' directive is not allowed. +# +# A 'comment' directive is always allowed. +# +# Permissions of directives are controlled on a per package basis. For each +# package, one or more seperate GPG public keyrings are maintained. All signed +# files that are part of a triplet must be signed by a permitted key for the +# specific package named in the directive file. Each package is only allowed +# write access to it's own directory (with the same name as the package) within +# the public ftp hierarchy. Write access to subdirectories of that directory is +# allowed. Limiting write access to specific directories on a per package basis +# minizes the impact from the compromise of a maintainer's GPG private key. The +# public keyrings form a hierarchy where keys in superdirectories can apply to +# files uploaded to subdirectories. Example: +# +# Jim can only upload to aspell/dict/en so his key is located in +# packages/aspell/dict/en/pubring.gpg. Paul can upload to any aspell +# directory so his key is in packages/aspell/pubring.gpg. When Paul +# uploads a file to aspell/dict/en it looks for his key in +# packages/aspell/dict/en/pubring.gpg first, then finds it in +# packages/aspell/pubring.gpg. +# +# Package config files are: +# 1. $package_config_base/$package_name/pubring.gpg +# GNUPG public keyring. For a given package, the directive +# file and file to be uploaded, must be signed with a key from +# the package's keyring. +# If a file is to be uploaded into a subdirectory of the package +# directory, the subdirectory in the package config directory will +# be checked for a pubring.gpg first, going up to the parent directory +# until a match is found. +# 2. $package_config_base/$package_name/email +# Email addresses that are sent mail when uploads succeed or +# fail for a given package. One email address per line. +# +# This is written for use with ftp instead of as a cgi script because we +# don't want to run an httpd on ftp.gnu.org. In general, it tries to do +# the minimum possible. +# +# We execute gpgv, lsof, mkdir, mv, and pwd. Executions are such that +# it's not possible for the shell to be invoked. We make use of Perl +# module Net::SMTP to send email. +# +# Originally written by Karl Berry (karl@gnu.org), October 2003. +# Additional changes by Paul Fisher (rao@gnu.org), November 2003 +# Additional functionality (v1.1) by Ward Vandewege (ward@gnu.org), May 2004 +# Additional changes (syslog) by Justin Baugh (baughj@gnu.org), August 2005 +# Additional testing and bugfixes by Ward Vandewege (ward@gnu.org), Apr 2006 + +use strict; +use Net::SMTP; +use Date::Manip; +use Sys::Syslog qw(:DEFAULT setlogsock); +use Getopt::Long; +umask (022); + +$ENV{"LC_ALL"} = "C"; # do not think about multibyte characters + +# Clean env so we can run subprograms, notably gpgv and lsof. +$ENV{"PATH"} = "/usr/bin:/bin:/usr/sbin"; +delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; + +my $V1_COMPAT_ALLOWED = 1; + +my $NAME = 'upload-ftp-v1.1.pl'; +my $VERSION = '1.1'; # This is the protocol version +my $DATE = '2006/12/04 11:00:44'; +my $AUTHOR = "the Free Software Foundation "; +my $COPYRIGHT = "2003-2006"; +my $LICENSE = "GPL - http://www.fsf.org/licenses/gpl.txt"; +my $URL = "http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html"; + +#my $NAME = $CVSNAME; +#$NAME =~ s/^.RCSfile: (.*?),v .$/$1/g; +#my $VERSION = $CVSVERSION; +#$VERSION =~ s/^.Revision: (.*?) .$/$1/g; +#my $DATE = $CVSDATE; +#$DATE =~ s/^.Date: (.*?) .*?.$/$1/g; + +my $style = ''; +my $help = ''; +my $version = ''; +# Set this to 1 or higher to get debug output in the log file. +my $DEBUG = 1; + +GetOptions ("style=s" => \$style, "debug=i" => \$DEBUG, "help" => \$help, "version" => \$version); + +&version_information () if ($version); +&usage_information() if ($help); +&usage_information() if (($style ne 'ftp') && ($style ne 'alpha') && ($style ne 'distros')); + +my $m_style = 'ftp'; +$m_style = 'alpha' if ($style eq 'alpha'); +$m_style = 'gnu+linux-distros' if ($style eq 'distros'); + +# Settings to configure: +my $package_config_base = "/home/gatekpr/packages"; +# where ftpd deposits the files for us to look at: +my $incoming_dir = "/home/upload/incoming/$m_style"; +# private dir on SAME FILESYSTEM as $incoming_dir: +my $incoming_tmp = "/var/tmp/$m_style-in"; +# top-level public ftp dir for installing files: +my $destfinal = "/home/$m_style/gnu"; +$destfinal = "/home/ftp/$m_style" if ($m_style eq 'gnu+linux-distros'); # The distros go here +# private dir on SAME FILESYSTEM as $destfinal: +my $olddestfinal = "/home/gatekpr/$m_style-archived"; +# private dir on SAME FILESYSTEM as $destfinal: +my $desttmp = "/var/tmp/$m_style-out"; + +my $master_keyring = "/home/gatekpr/etc/master_pubring.gpg"; + +my $log_style = 'GNU'; +$log_style = 'Alpha' if ($style eq 'alpha'); +$log_style = 'Distros' if ($style eq 'distros'); + +# maintainer e-mail address +my $maintainer_email = "ward\@gnu.org"; + +my $serials_path = "/home/gatekpr/etc/upload-ftp-serials.txt"; + +my $email_always = 'ftp-upload-script@gnu.org'; # e.g., ftp-upload@gnu.org + +# syslog destination +my $facility = "LOCAL5"; + +my %info; # package being processed; a global so fatal and mail can use it + +exit (&main ()); + +sub main +{ + + # Initialize our syslogging + setlogsock('unix'); + openlog("ftp-upload", 'pid', $facility); + ftp_syslog('info', "($log_style) Beginning upload processing run."); + + # make sure our directories all exist, or it's hopeless. + # Use die instead of fatal - this error should "never" happen. + for my $dir ($package_config_base, $incoming_dir, $incoming_tmp, + $destfinal, $desttmp) { + -d $dir || ftp_die("FATAL: configuration problem, $dir is not a directory"); + } + + # the chdir simplifies our filename parsing, so the base names don't + # have any directory. + chdir ($incoming_dir) || ftp_die("FATAL: chdir($incoming_dir) failed: $!"); + my @incoming = &scan_incoming (); + + # we've moved the files to work on to a new directory. + chdir ($incoming_tmp) || ftp_die("FATAL: chdir($incoming_tmp) failed: $!"); + + for my $files (@incoming) { # each list element is a hash reference. + ftp_syslog('info',"($log_style) found directive: $files->{directive}\n"); + # if we die processing a triplet, the eval allows us to move + # onto the next triplet. + eval { + # set up the %info variable + &read_directive_file ($files->{"directive"},$files->{"upload"},$files->{"directive_only"}); + + # do the work + &execute_commands($files,%info); + + # report success + if (!$files->{"directive_only"}) { + &success_upload($files->{"sig"}, $files->{"upload"},$files->{"directive"}); + } else { + &success_directive($files->{directive}); + } + }; + + # clean up files if we abort while processing a triplet + cleanup ($files->{"sig"}, $files->{"upload"}, $files->{"directive"}) if ($@); + # clear out the current package that we just finished processing + undef %info; + } + if ((scalar @incoming) == 0) { + ftp_syslog('info', "($log_style) No files found for processing."); + } else { + ftp_syslog('info', "($log_style) Processing complete: " . (scalar @incoming) . " uploads processed."); + } + + # Clean up the incoming directory and the incoming tmp directory - remove files older than a day + cleanup_dir($incoming_dir); + cleanup_dir($incoming_tmp); + + return 0; +} + +sub usage_information { + my $retval = "\n$NAME protocol v$VERSION ($DATE)\n"; + $retval .= "More information at $URL\n"; + $retval .= "\nERROR: You have not supplied all required parameters. $NAME takes these arguments:\n\n"; + $retval .= " $NAME -s