From f1bbbe2c93f23e361bdcec06a782e620673bef9d Mon Sep 17 00:00:00 2001 From: unknown Date: Fri, 21 Sep 2012 14:11:57 -0500 Subject: [PATCH] Import version as of 2012-09-21 for upload-ftp-v1.2.pl --- upload-ftp-v1.2.pl | 1364 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1364 insertions(+) create mode 100755 upload-ftp-v1.2.pl diff --git a/upload-ftp-v1.2.pl b/upload-ftp-v1.2.pl new file mode 100755 index 0000000..538cb49 --- /dev/null +++ b/upload-ftp-v1.2.pl @@ -0,0 +1,1364 @@ +#!/usr/bin/perl -Tw + +# +# Take files that have been uploaded via ftp and move them into place on +# ftp.gnu.org. +# + + +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# +# Short overview +# +# 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 its 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 +# minimizes 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, pwd and tar. 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 - Jan 2010 + +use strict; +use Net::SMTP; +use Date::Manip; +use Sys::Syslog qw(:DEFAULT setlogsock); +use Getopt::Long; +use Text::Wrap; +use POSIX qw(strftime); +use Cwd; +use Email::MessageID; +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 = 0; + +my $NAME = 'upload-ftp-v1.1.pl'; +my $VERSION = '1.2'; # This is the protocol version +my $DATE = '2012/09/21 10:18:29'; +my $AUTHOR = "Free Software Foundation "; +my $COPYRIGHT = "2003-2012"; +my $LICENSE = "GPLv3 or later - http://www.fsf.org/licenses/gpl.txt"; +my $URL = "http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html"; + +my $style = ''; +my $help = ''; +my $version = ''; +# Set this to 1 or higher to get debug output in the log file. +my $DEBUG = 1; + +my $NOMAIL = 0; + +# Set this to 0 to disable the timestamp check on uploaded files in sub scan_incoming +my $TSTAMPCHECK = 1; + +GetOptions ("style=s" => \$style, "tstampcheck=i" => \$TSTAMPCHECK, "nomail=i" => \$NOMAIL, "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"; + +# We sometimes want to exclude e-mail addresses from being emailed. +# Specifically, e-mail addresses we import from gpg keys - keys are still valid +# but associated e-mail addresses are not. Ward, 2011-02-08. +my $email_blacklist = "/home/gatekpr/etc/email_blacklist"; + +# List of all package maintainers +my $maintainers_bypkg = "/home/gatekpr/etc/maintainers.bypkg"; + +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 = "ftp-upload-report\@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 + my $retval = &read_directive_file ($files->{"directive"},$files->{"upload"},$files->{"directive_only"}); + + if ($retval == 0) { + # 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}); + } + } + }; + ftp_warn ("eval failed: $@") if $@; + + # 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