FileList.pm

Modules

Functions:


Main Script

Variables:

Calls:

Comments:

###############################################################################
#
#                                Confidential
#             Disclosure And Distribution Solely to Employees of
#          Hewlett-Packard and Its Affiliates Having a Need to Know
#
#                  Copyright @ 1998, Hewlett-Packard, Inc.,
#                            All Rights Reserved
#
###############################################################################
#
#   @(#)$Id: FileList_doc.html,v 1.1 2000/05/04 21:14:15 idsweb Exp $
#
#   Description:    Provide an interface by which an application can have files
#                   written locally while also arranging for them to be
#                   propagated to any mirrors of this host.
#
#   Functions:      upload_files
#                   error
#
#   Libraries:      IMS::ReleaseMgr
#
#   Global Consts:  $VERSION            Version information for this module
#                   $revision           Copy of the RCS revision string
#
#   Environment:    None.
#
###############################################################################
$VERSION = do {my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
###############################################################################
#
#   Sub Name:       upload_files
#
#   Description:    Take the list of files, along with other parameters, and
#                   create a properly-crafted tar file which is then managed
#                   via IMS::ReleaseMgr::new().
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $user     in      scalar    Authenticated user name
#                   $mirror   in      scalar    Mirror group
#                   $project  in      scalar    Name of the project that data
#                                                 is for.
#                   $basedir  in      scalar    Base directory path element(s)
#                                                 under $project for files to
#                                                 be put into
#                   $files    in      hashref   Hash table reference for the
#                                                 files. Keys are file names
#                                                 (rel. to $project/$basedir)
#                                                 and values are either local
#                                                 file names or IO::File refs.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0
#
###############################################################################/n

Code:

###############################################################################
#
#                                Confidential
#             Disclosure And Distribution Solely to Employees of
#          Hewlett-Packard and Its Affiliates Having a Need to Know
#
#                  Copyright @ 1998, Hewlett-Packard, Inc.,
#                            All Rights Reserved
#
###############################################################################
#
#   @(#)$Id: FileList_doc.html,v 1.1 2000/05/04 21:14:15 idsweb Exp $
#
#   Description:    Provide an interface by which an application can have files
#                   written locally while also arranging for them to be
#                   propagated to any mirrors of this host.
#
#   Functions:      upload_files
#                   error
#
#   Libraries:      IMS::ReleaseMgr
#
#   Global Consts:  $VERSION            Version information for this module
#                   $revision           Copy of the RCS revision string
#
#   Environment:    None.
#
###############################################################################
package IMS::ReleaseMgr::FileList;

use 5.002;
use strict;
use vars           qw(@ISA @EXPORT @EXPORT_OK $VERSION $revision
                      $error_text $TAR %inc_dirs);
use subs           qw(upload_files error);
use Carp;
use File::Path     qw(mkpath rmtree);
use File::Copy     qw(copy);
use File::Basename qw(dirname);
use Cwd            qw(cwd);

require Exporter;
require IO::File;
require IMS::ReleaseMgr;

$VERSION = do {my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
$revision = q$Id: FileList_doc.html,v 1.1 2000/05/04 21:14:15 idsweb Exp $;
$error_text = '';
$TAR = '/bin/tar';
@ISA = qw(Exporter);
@EXPORT = qw(upload_files error);
@EXPORT_OK = @EXPORT;
%inc_dirs = (
             'www.interactive.hp.com' => '/opt/ims/incoming',
             'www.dmo.hp.com'         => '/usr/local/etc/httpd/incoming',
             'www.shopping.hp.com'    => '/opt/ims/incoming',
             'www.buy.hp.com',        => '/opt/ims/www.buy.hp.com/incoming'
            );
1;

###############################################################################
#
#   Sub Name:       upload_files
#
#   Description:    Take the list of files, along with other parameters, and
#                   create a properly-crafted tar file which is then managed
#                   via IMS::ReleaseMgr::new().
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $user     in      scalar    Authenticated user name
#                   $mirror   in      scalar    Mirror group
#                   $project  in      scalar    Name of the project that data
#                                                 is for.
#                   $basedir  in      scalar    Base directory path element(s)
#                                                 under $project for files to
#                                                 be put into
#                   $files    in      hashref   Hash table reference for the
#                                                 files. Keys are file names
#                                                 (rel. to $project/$basedir)
#                                                 and values are either local
#                                                 file names or IO::File refs.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0
#
###############################################################################
sub upload_files


Function: upload_files

Variables:

Calls:

Comments:

###############################################################################
#
#                                Confidential
#             Disclosure And Distribution Solely to Employees of
#          Hewlett-Packard and Its Affiliates Having a Need to Know
#
#                  Copyright @ 1998, Hewlett-Packard, Inc.,
#                            All Rights Reserved
#
###############################################################################
#
#   @(#)$Id: FileList_doc.html,v 1.1 2000/05/04 21:14:15 idsweb Exp $
#
#   Description:    Provide an interface by which an application can have files
#                   written locally while also arranging for them to be
#                   propagated to any mirrors of this host.
#
#   Functions:      upload_files
#                   error
#
#   Libraries:      IMS::ReleaseMgr
#
#   Global Consts:  $VERSION            Version information for this module
#                   $revision           Copy of the RCS revision string
#
#   Environment:    None.
#
###############################################################################
$VERSION = do {my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
###############################################################################
#
#   Sub Name:       upload_files
#
#   Description:    Take the list of files, along with other parameters, and
#                   create a properly-crafted tar file which is then managed
#                   via IMS::ReleaseMgr::new().
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $user     in      scalar    Authenticated user name
#                   $mirror   in      scalar    Mirror group
#                   $project  in      scalar    Name of the project that data
#                                                 is for.
#                   $basedir  in      scalar    Base directory path element(s)
#                                                 under $project for files to
#                                                 be put into
#                   $files    in      hashref   Hash table reference for the
#                                                 files. Keys are file names
#                                                 (rel. to $project/$basedir)
#                                                 and values are either local
#                                                 file names or IO::File refs.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0
#
###############################################################################/n/n     #
    # basic data sanity checks:
    #
    # Make a 'clean' base, without extra // or /./
    #
    # Get a name for a temp dir that isn't already in use
    #
        # Leading / not really a problem, but remove them along with trailing
        #
        # Create any needed subdirectories
        #
        # If this is not an ordinary scalar-string (name):
        # Again, if this is not an ordinary scalar-string (name):
    # Write a weblist for this soon-to-be tar file
    print $WL "# weblist generated for $user by $revision, " .
    #
    # Now create the tar file
    #
    #
    # Expect to replace this with Archive::Tar soon
    #
    #
    # Later, we'll make this more flexible...
    #
    #
    # Successfully processed
    #
    undef $PKG; # Force destructor now, rather than at exit

Code:

{
    my ($user, $mirror, $project, $basedir, $files) = @_;

    my ($tmpdir, $tmptar, $cwd, $file, $WL, $PKG, $directory);

    #
    # basic data sanity checks:
    #
    if ($project !~ /^([\w\-\+])+$/o)
    {
        error "The project name ($project) may only contain alphanumerics, " .
            "- and +";
        return 0;
    }
    if ($basedir =~ /\.\./o)
    {
        error "The base-directory specification ($basedir) may not contain " .
            "any occurrances of ``..''";
        return 0;
    }
    if (grep(/\.\./o, (keys %$files)))
    {
        error "The file name specifications may not contain any occurrances " .
            "of ``..''";
        return 0;
    }
    # Make a 'clean' base, without extra // or /./
    $basedir =~ s|^/||go;
    $basedir =~ s|/$||go;
    $basedir =~ s|/\./|/|go;
    $basedir =~ s|//|/|go;

    #
    # Get a name for a temp dir that isn't already in use
    #
    $tmpdir = "/tmp/irMfL-$$";
    $tmpdir++ while (-e $tmpdir);
    umask 02;
    mkpath("$tmpdir/$project/$basedir", 0, 0775);

    $cwd = cwd;
    for $file (sort keys %$files)
    {
        # Leading / not really a problem, but remove them along with trailing
        $file =~ s|^/||go;
        $file =~ s|/$||go;

        #
        # Create any needed subdirectories
        #
        if ($file =~ m|/|o)
        {
            my $dir = dirname $file;
            mkpath "$tmpdir/$project/$basedir/$dir", 0, 0775;
        }
        # If this is not an ordinary scalar-string (name):
        seek($files->{$file}, 0, 0) if (ref $files->{$file});
        if (! copy($files->{$file}, "$tmpdir/$project/$basedir/$file"))
        {
            error "Copy failed to file $tmpdir/$project/$basedir/$file: $!";
            rmtree $tmpdir;
            return 0;
        }
        # Again, if this is not an ordinary scalar-string (name):
        seek($files->{$file}, 0, 0) if (ref $files->{$file});
        chmod 0644, "./$file";
    }

    # Write a weblist for this soon-to-be tar file
    $WL = new IO::File "> $tmpdir/$project/weblist";
    unless (defined $WL)
    {
        error "Could not open $tmpdir/$project/weblist for writing: $!";
        rmtree $tmpdir;
        return 0;
    }
    print $WL "# weblist generated for $user by $revision, " .
        (scalar localtime) . "\n";
    print $WL (map
           {
               ($file = $_) =~ s|^/||go;
               $file =~ s|/$||go;
               $file =~ s|//|/|go;
               $file =~ s|/\./|/|go;
               $file = ($basedir) ? "$basedir/$file" : $file;

               sprintf("%s\t%s\t%s\n",
                       ($file =~ /(jpg|gif|pdf)$/oi) ? 'Fig' : 'Doc',
                       $file, "/$project/" . dirname $file);
           }
               sort (keys %$files));
    $WL->close;

    #
    # Now create the tar file
    #
    chdir $tmpdir;
    if ($?)
    {
        error "Could not chdir to $tmpdir: $!";
        chdir $cwd;
        rmtree $tmpdir;
        return 0;
    }
    #
    # Expect to replace this with Archive::Tar soon
    #
    system("$TAR cf $project.tar $project 2>&1 > /dev/null");
    $? >>= 8;
    if ($?)
    {
        error "System error executing ``$TAR cf $project.tar $project'': $!";
        chdir $cwd;
        rmtree $tmpdir;
        return 0;
    }

    #
    # Later, we'll make this more flexible...
    #
    $directory = $inc_dirs{$mirror} || '/tmp';
    $PKG = new IMS::ReleaseMgr(name      => $project,
                               user      => $user,
                               nomail    => 1,
                               file      => "$tmpdir/$project.tar",
                               directory => $directory);
    unless (defined $PKG)
    {
        error "Unable to create upload package";
        chdir $cwd;
        rmtree $tmpdir;
        return 0;
    }
    unless ($PKG->validate)
    {
        my ($err, $file, $line) = $PKG->error;
        $PKG->abort;
        error "Package upload error detected at $file, line $line: $err";
        chdir $cwd;
        rmtree $tmpdir;
        return 0;
    }

    unless ($PKG->commit)
    {
        my ($err, $file, $line) = $PKG->error;
        $PKG->abort;
        error "Package upload error detected at $file, line $line: $err";
        chdir $cwd;
        rmtree $tmpdir;
        return 0;
    }

    #
    # Successfully processed
    #
    $PKG->close;
    undef $PKG; # Force destructor now, rather than at exit

    error '';

    1;
}


Function: error

Variables:

Calls:

Comments:

###############################################################################
#
#   Sub Name:       error
#
#   Description:    Get/set the message associated with the most recent error
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $text     in      scalar    If passed, set the error text
#                                                 to this before returning.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        current error text
#
###############################################################################/n/n 

Code:

{
    my $text = shift;

    $IMS::ReleaseMgr::FileList::error_text = $text
        if (defined $text and $text);

    $IMS::ReleaseMgr::FileList::error_text;
}