Transfer.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: Transfer_doc.html,v 1.1 2000/05/04 21:14:21 idsweb Exp $
#
#   Description:    Package up the actual transfer mechanism by which released
#                   pacakges are moved around between machines. Currently only
#                   supports the HTTP upload mechanism, but will act as a good
#                   abstraction layer if FTP is ever to be supported.
#
#   Functions:      mirror_upload
#                   ftp_upload
#                   ftp_error
#                   send_and_expect
#
#   Libraries:      IMS::ReleaseMgr::Utils
#                   LWP::UserAgent
#                   HTTP::Request::Common
#                   URI::URL
#
#   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:       ftp_upload
#
#   Description:    Transfer a package using an automated FTP session
#
#                   8/1/99: It's time to make the API to this routine match
#                   that of the mirror_upload() routine more closely. This is
#                   now going to be used for more than just backwards-
#                   compatibility with www.hp.com.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $tarfile  in      scalar    Filename for the tar archive
#                   $infofile in      scalar    Filename for the ticket file
#                   $thishost in      scalar    The name this host goes by in
#                                                 mirror terms
#                   $host     in      scalar    Host to FTP to.
#                   $ftp_program  in  scalar    path to socksified ftp program
#                   $config   in      hashref   The relevant host config
#                                                 block for the mirror group
#                   $tarfile_remote  in      scalar    Remote filename for the tar archive (optional)
#                   $infofile_remote in      scalar    Remote filename for the ticket file (optional)
#
#                   Note that this routine does not use the %info block, as
#                   the info file has to already physically exist. That also
#                   means that the caller is responsible for setting the
#                   "upload" and "transfer method" settings correctly.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0, error text retrievable via ftp_error()
#
###############################################################################/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: Transfer_doc.html,v 1.1 2000/05/04 21:14:21 idsweb Exp $
#
#   Description:    Package up the actual transfer mechanism by which released
#                   pacakges are moved around between machines. Currently only
#                   supports the HTTP upload mechanism, but will act as a good
#                   abstraction layer if FTP is ever to be supported.
#
#   Functions:      mirror_upload
#                   ftp_upload
#                   ftp_error
#                   send_and_expect
#
#   Libraries:      IMS::ReleaseMgr::Utils
#                   LWP::UserAgent
#                   HTTP::Request::Common
#                   URI::URL
#
#   Global Consts:  $VERSION            Version information for this module
#                   $revision           Copy of the RCS revision string
#
#   Environment:    None.
#
###############################################################################
package IMS::ReleaseMgr::Transfer;

use 5.004;
use strict;
use subs qw(mirror_upload ftp_upload ftp_error send_and_expect);
use vars qw($VERSION $revision @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
            @ftp_error);
use Carp;
use Cwd 'cwd';
use AutoLoader 'AUTOLOAD';
use Symbol 'gensym';
require Exporter;

use IMS::ReleaseMgr::Utils qw(write_log_line send_mail);
use LWP::UserAgent;
use HTTP::Request::Common  qw(POST $DYNAMIC_FILE_UPLOAD);
use URI::URL;

$VERSION = do {my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
$revision = q{$Id: Transfer_doc.html,v 1.1 2000/05/04 21:14:21 idsweb Exp $ };

@ISA         = qw(Exporter);
@EXPORT      = qw(mirror_upload ftp_upload ftp_error);
@EXPORT_OK   = qw(mirror_upload ftp_upload ftp_error);
%EXPORT_TAGS = ('ftp' => [qw(ftp_upload ftp_error)]);

1;

###############################################################################
#
#   Sub Name:       ftp_upload
#
#   Description:    Transfer a package using an automated FTP session
#
#                   8/1/99: It's time to make the API to this routine match
#                   that of the mirror_upload() routine more closely. This is
#                   now going to be used for more than just backwards-
#                   compatibility with www.hp.com.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $tarfile  in      scalar    Filename for the tar archive
#                   $infofile in      scalar    Filename for the ticket file
#                   $thishost in      scalar    The name this host goes by in
#                                                 mirror terms
#                   $host     in      scalar    Host to FTP to.
#                   $ftp_program  in  scalar    path to socksified ftp program
#                   $config   in      hashref   The relevant host config
#                                                 block for the mirror group
#                   $tarfile_remote  in      scalar    Remote filename for the tar archive (optional)
#                   $infofile_remote in      scalar    Remote filename for the ticket file (optional)
#
#                   Note that this routine does not use the %info block, as
#                   the info file has to already physically exist. That also
#                   means that the caller is responsible for setting the
#                   "upload" and "transfer method" settings correctly.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0, error text retrievable via ftp_error()
#
###############################################################################
sub ftp_upload


Function: ftp_upload

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: Transfer_doc.html,v 1.1 2000/05/04 21:14:21 idsweb Exp $
#
#   Description:    Package up the actual transfer mechanism by which released
#                   pacakges are moved around between machines. Currently only
#                   supports the HTTP upload mechanism, but will act as a good
#                   abstraction layer if FTP is ever to be supported.
#
#   Functions:      mirror_upload
#                   ftp_upload
#                   ftp_error
#                   send_and_expect
#
#   Libraries:      IMS::ReleaseMgr::Utils
#                   LWP::UserAgent
#                   HTTP::Request::Common
#                   URI::URL
#
#   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:       ftp_upload
#
#   Description:    Transfer a package using an automated FTP session
#
#                   8/1/99: It's time to make the API to this routine match
#                   that of the mirror_upload() routine more closely. This is
#                   now going to be used for more than just backwards-
#                   compatibility with www.hp.com.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $tarfile  in      scalar    Filename for the tar archive
#                   $infofile in      scalar    Filename for the ticket file
#                   $thishost in      scalar    The name this host goes by in
#                                                 mirror terms
#                   $host     in      scalar    Host to FTP to.
#                   $ftp_program  in  scalar    path to socksified ftp program
#                   $config   in      hashref   The relevant host config
#                                                 block for the mirror group
#                   $tarfile_remote  in      scalar    Remote filename for the tar archive (optional)
#                   $infofile_remote in      scalar    Remote filename for the ticket file (optional)
#
#                   Note that this routine does not use the %info block, as
#                   the info file has to already physically exist. That also
#                   means that the caller is responsible for setting the
#                   "upload" and "transfer method" settings correctly.
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0, error text retrievable via ftp_error()
#
###############################################################################/n/n     # Don't mirror to ourselves
    #
    # Create filehandle-usable objects for the open3 call:
    #
    $@ = '';   # Clear out before the eval
        if ($trace & 2); # bxxxxxx1x
    #
    # Connect to the target host
    #
    #
    # Log in using the username and password passed in the configuration
    #
    #
    # Ensure that we transfer in binary mode
    #
    #
    # The FTP session is now established. We have three commands to
    # execute: A cd (change dir), put the tarfile, and put the infofile.
    # The cd command may not be needed.
    #
    #
    # Send the files. Send the tarfile first, as a large-enough tarfile
    # could take just long enough to transfer for the release manager on
    # the other end to see the infofile and commence processing before
    # we've actually finished transferring the content.
    #
    # I speak from experience.
    #
        # Give it a bit to clear buffers
    # Give it a bit to clear buffers

Code:

{
    my ($tarfile, $infofile, $thishost, $host, $ftp_program, $config, 
	$tarfile_remote, $infofile_remote) = @_;

    use IPC::Open3;

    my ($user, $password, $ftp_pid, $ftp, $reply, $send, $recv, $perr,
        $xfer_dir, $trace, $tfile, $cmd, $ver, $cwd, $DIR, $TAR, $INFO,%REMOTE);

    # Don't mirror to ourselves
    return 1 if ($host eq $thishost);

    $trace = $main::trace || 0;
    $tfile = $main::tfile || '-';
    $cmd   = $main::cmd   || ($0 =~ m|(.*)/(.*)$|o)[1];
    $ver   = (defined $main::VERSION) ? "/$main::VERSION" : '';
    write_log_line($tfile, "$cmd [$$] FTP-based mirroring to $host")
        if ($trace);

    $user     = $config->{FTP_USER};
    $password = $config->{FTP_PASSWD};
    $ftp      = $ftp_program || $ENV{FTP} || '/opt/ims/bin/ftp';
    $xfer_dir = $config->{FTP_DIR} || $config->{INCOMING_DIR} || undef;

    unless ($user and $password)
    {
        ftp_error('One of the user name, password or host was not configured');
        return 0;
    }

    $cwd = cwd;
    ($DIR, $TAR) = $tarfile =~ m|^(.*)/(.*)$|;
    $REMOTE{$TAR} = ($tarfile_remote =~ m|^(.*)/(.*)$|)[1] || $TAR;
    $INFO = ($infofile =~ m|^(.*)/(.*)$|)[1];
    $REMOTE{$INFO} = ($infofile_remote =~ m|^(.*)/(.*)$|)[1] || $INFO;
    chdir $DIR;

    #
    # Create filehandle-usable objects for the open3 call:
    #
    ($send, $recv, $perr) = (gensym, gensym, gensym);

    $@ = '';   # Clear out before the eval
    eval { $ftp_pid = open3($send, $recv, $perr, "$ftp -v -n") };

    if ($@)
    {
        ftp_error("Error from open of ftp command: $@");
        return 0;
    }

    write_log_line($tfile,
                   sprintf("$cmd [$$] [%s] Attempting ftp mirror to $host",
                           scalar localtime time))
        if ($trace & 2); # bxxxxxx1x

    #
    # Connect to the target host
    #
    $reply = send_and_expect($send, $recv,
                             "open $host\n",
                             '^([245]\d\d )|(.*(unknown)|(refused))');
    if ($reply !~ /^2/)
    {
        ftp_error("Unable to open host '$host': $reply");
        print $send "quit\n";
        close $send;
        close $recv;
        close $perr;
        waitpid($ftp_pid, 0);
        return 0;
    }

    #
    # Log in using the username and password passed in the configuration
    #
    $reply = send_and_expect($send, $recv,
                             "user $user $password\n", '^[245]\d\d ');
    if ($reply !~ /^2/)
    {
        ftp_error("Unable to login as $user to $host: $reply");
        print $send "quit\n";
        close $send;
        close $recv;
        close $perr;
        waitpid($ftp_pid, 0);
        return 0;
    }

    #
    # Ensure that we transfer in binary mode
    #
    $reply = send_and_expect($send, $recv, "binary\n", '^200 ');

    #
    # The FTP session is now established. We have three commands to
    # execute: A cd (change dir), put the tarfile, and put the infofile.
    # The cd command may not be needed.
    #
    if (defined $xfer_dir and $xfer_dir)
    {
        $reply = send_and_expect($send, $recv,
                                 "cd $xfer_dir\n", '^[245]\d\d ');
        if ($reply !~ /^2/)
        {
            ftp_error("Unable to cd to $xfer_dir on $host: $reply");
            print $send "quit\n";
            close $send;
            close $recv;
            close $perr;
            waitpid($ftp_pid, 0);
            return 0;
        }
    }

    #
    # Send the files. Send the tarfile first, as a large-enough tarfile
    # could take just long enough to transfer for the release manager on
    # the other end to see the infofile and commence processing before
    # we've actually finished transferring the content.
    #
    # I speak from experience.
    #
    for my $file ($TAR, $INFO)
    {
        $reply = send_and_expect($send, $recv,
                                 "put $file $REMOTE{$file}.LCK\n", '^[245]\d\d ');
        if ($reply !~ /^2/)
        {
            ftp_error('Error sending file to remote host',
                      "Unable to transfer $file to $host: $reply");
            print $send "quit\n";
            close $send;
            close $recv;
            close $perr;
            waitpid($ftp_pid, 0);
            return 0;
        }
        
        # Give it a bit to clear buffers
        sleep 2;

        $reply = send_and_expect($send, $recv,
                                 "rename $REMOTE{$file}.LCK $REMOTE{$file}\n", '^[245]\d\d ');
        if ($reply !~ /^2/)
        {
            ftp_error('Error sending file to remote host',
                      "Unable to transfer $file to $host: $reply");
            print $send "quit\n";
            close $send;
            close $recv;
            close $perr;
            waitpid($ftp_pid, 0);
            return 0;
        }
    }

    # Give it a bit to clear buffers
    sleep 2;
    $reply = send_and_expect($send, $recv, "close\n", '^[245]\d\d ');
    print $send "quit\n";
    close $send;
    close $recv;
    close $perr;
    waitpid($ftp_pid, 0);

    chdir $cwd;
    1;
}


Function: ftp_error

Variables:

Calls:

Comments:

###############################################################################
#
#   Sub Name:       ftp_error
#
#   Description:    Set/return error text from an ftp attempt
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   @text     in      list      If passed, new text for error
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        void or error text, depending on context
#
###############################################################################/n/n         #
        # Set error text and return a void context
        #

Code:

{
    my @text = @_;

    if (defined $text[0] and $text[0])
    {
        #
        # Set error text and return a void context
        #
        @IMS::ReleaseMgr::Transfer::ftp_error = @text;
        return;
    }
    else
    {
        return @IMS::ReleaseMgr::Transfer::ftp_error;
    }
}


Function: send_and_expect

Variables:

Calls:

Comments:

###############################################################################
#
#   Sub Name:       send_and_expect
#
#   Description:    Send the string $send out along $ofh and wait for a pattern
#                   matching $expect to come in on $ifh.
#
#                   Perl 5.005 will give us regex's as first-class object, and
#                   usage of $expect will become much simpler then.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $ofh      in      globref   Output FH (writer)
#                   $ifh      in      globref   Input FH (reader)
#                   $send     in      scalar    Text to write to $ofh
#                   $expect   in      scalar    Pattern to look for on $ifh
#                   $debug    in      scalar    Flag that tells whether to
#                                                 do any debug output to STDERR
#
#   Globals:        None.
#
#   Environment:    None.
#
#   Returns:        Success:    the text line matched by $expect
#                   Failure:    dunno-- deadlock loop? undef if EOF reached
#
###############################################################################/n/n     $debug |= 0; # Force a strict-clean testable value

Code:

{
    my ($ofh, $ifh, $send, $expect, $debug) = @_;

    $debug |= 0; # Force a strict-clean testable value

    print STDERR "> $send" if ($debug and $send !~ /user|pass/);
    print $ofh $send;

    my $line;
    while (defined($line = <$ifh>))
    {
        print STDERR "< $line" if $debug;
        return $line if $line =~ /$expect/;
    }

    undef;
}


Function: mirror_upload

Variables:

Calls:

Comments:

###############################################################################
#
#   Sub Name:       mirror_upload
#
#   Description:    Upload a package to the specified hosts using the HTTP
#                   protocol and the relevant bits from the confguration.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $file     in      scalar    Full path to file to upload
#                   $project  in      scalar    Name of project that owns this
#                   $thishost in      scalar    Name of the host currently on
#                   $hostlist in      listref   List of hosts to mirror to
#                   $config   in      hashref   Configuration information for
#                                                 this running host/pool
#                   $info     in      hashref   Values from the info file
#
#   Globals:        Looks for $cmd, $hostname, $trace, $tfile
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0, followed by two listrefs with details
#
###############################################################################/n/n     #
    # Make a local copy of this so we can delete some of the keys safely
    #
    #
    # This prevents a loop -- without it, the package bounces between all
    # servers ad infitum
    #
    #
    # Set to use dyn file uploading for largish files (> 5K)
    #
        # Don't mirror to ourselves
            if ($trace & 2); # bxxxxxx1x
        # Creates some kind of magical munging for the URL string given
        # Set up the user/password for the access realm
        # Actual request made to the remote host
                                     # Pick up any other ticket file options
        # Make sure we have a content length
            # create anonymous temporary file
            # fill it with data
            # Update request
            # Update content as a closure that reads the file back
        #
        # Make $MIRROR_RETRIES attempts at mirroring this package. If there is
        # an error, wait for a period of $MIRROR_WAIT_PERIOD seconds and try
        # again. Drop out of the loop as soon as we have a success.
        #
            # Sleep unless we're on the last iteration of the loop
            #
            # Some sort of an error occured. We don't want to drop out just
            # yet, because there may be more hosts yet to process. So keep a
            # pair of lists with the failed host and corresponding error
            # message. We'll report it all after the loop.
            #

Code:

{
    my ($file, $project, $thishost, $hostlist, $config, $info) = @_;

    my (@bad, @err_content, $URI, $UA, $host, $request, $res, $fh, $cmd, %info,
        $trace, $tfile, $email, $MIRROR_RETRIES, $MIRROR_WAIT_PERIOD, $ver);

    $MIRROR_RETRIES     = 3;
    $MIRROR_WAIT_PERIOD = 30;

    $trace = $main::trace || 0;
    $tfile = $main::tfile || '-';
    $cmd   = $main::cmd   || ($0 =~ m|(.*)/(.*)$|o)[1];
    $ver   = (defined $main::VERSION) ? "/$main::VERSION" : '';
    write_log_line($tfile, "$cmd [$$] HTTP-base mirroring starts (@$hostlist)")
        if ($trace);

    #
    # Make a local copy of this so we can delete some of the keys safely
    #
    %info = %{$info};
    $email = $info{email} || '';
    delete $info{email};
    delete $info{project};

    #
    # This prevents a loop -- without it, the package bounces between all
    # servers ad infitum
    #
    $info{upload} = 'no' unless (defined $info{upload});

    #
    # Set to use dyn file uploading for largish files (> 5K)
    #
    $DYNAMIC_FILE_UPLOAD = 1 if ((-s $file) > 5120);
    @bad = (); @err_content = ();
    for $host (@$hostlist)
    {
        # Don't mirror to ourselves
        next if ($host eq $thishost);

        write_log_line($tfile,
                       sprintf("$cmd [$$] [%s] Attempting mirror to $host",
                               scalar localtime time))
            if ($trace & 2); # bxxxxxx1x

        # Creates some kind of magical munging for the URL string given
        $URI = new URI::URL "http://$host$config->{UPLOAD_URL}";
        $UA = new LWP::UserAgent;
        # Set up the user/password for the access realm
        $UA->credentials($URI->netloc,
                         $config->{UPLOAD_REALM},
                         $config->{HTTP_AUTH_USER},
                         $config->{HTTP_AUTH_PASSWD});
        $UA->agent("$cmd$ver " . $UA->agent);
        $UA->proxy('http', $ENV{http_proxy})
            if (defined $ENV{http_proxy} and $ENV{http_proxy});
        # Actual request made to the remote host
        $request = POST($URI,
                        Content_Type => 'form-data',
                        Content => [ project    => $project,
                                     input_file => [$file],
                                     email      => $email,
                                     # Pick up any other ticket file options
                                     %info ]);
        $request->authorization_basic($config->{HTTP_AUTH_USER},
                                      $config->{HTTP_AUTH_PASSWD});
        # Make sure we have a content length
        unless (defined $request->content_length)
        {
            my $code = $request->content;

            # create anonymous temporary file
            my $tmpfile = "/tmp/form-data-content-$$";
            $fh = gensym;
            unless (open($fh, "+>$tmpfile"))
            {
                write_log_line($tfile,
                               sprintf("$cmd [$$] [%s] Cannot create " .
                                       "$tmpfile: $!",
                                       scalar localtime time))
                    if ($trace);
                write_log_line("$config->{LOGGING_DIR}/$cmd",
                               sprintf("%s [$$] Cannot create $tmpfile: $!",
                               scalar localtime time));
                die "Can't create $tmpfile: $!";
            }
            unless (unlink($tmpfile))
            {
                write_log_line($tfile,
                               sprintf("$cmd [$$] [%s] Cannot unlink " .
                                       "$tmpfile: $!",
                                       scalar localtime time))
                    if ($trace);
                write_log_line("$config->{LOGGING_DIR}/$cmd",
                               sprintf("%s [$$] Cannot unlink $tmpfile: $!",
                               scalar localtime time));
                die "Can't unlink $tmpfile";
            }

            # fill it with data
            my $chunk;
            my $size = 0;
            while (defined($chunk = &$code) && length($chunk))
            {
                print $fh $chunk;
                $size += length($chunk);
            }
            unless (seek($fh, 0, 0))
            {
                write_log_line($tfile,
                               sprintf("$cmd [$$] [%s] Cannot rewind: $! ",
                                       scalar localtime time))
                    if ($trace);
                write_log_line("$config->{LOGGING_DIR}/$cmd",
                               sprintf("%s [$$] Cannot rewind: $!",
                               scalar localtime time));
                die "Can't rewind: $!";
            }

            # Update request
            $request->content_length($size);

            # Update content as a closure that reads the file back
            $request->content(sub {
                                  my $buf = "";
                                  my $n = read($fh, $buf, 1024);
                                  unless (length $buf)
                                  {
                                      seek($fh, 0, 0);
                                  }
                                  $buf;
                              });
        }

        #
        # Make $MIRROR_RETRIES attempts at mirroring this package. If there is
        # an error, wait for a period of $MIRROR_WAIT_PERIOD seconds and try
        # again. Drop out of the loop as soon as we have a success.
        #
        for my $loop (1 .. $MIRROR_RETRIES)
        {
            $res = $UA->simple_request($request);
            last if $res->is_success;
            # Sleep unless we're on the last iteration of the loop
            sleep $MIRROR_WAIT_PERIOD unless ($loop == $MIRROR_RETRIES);
        }
        if ($res->is_error)
        {
            #
            # Some sort of an error occured. We don't want to drop out just
            # yet, because there may be more hosts yet to process. So keep a
            # pair of lists with the failed host and corresponding error
            # message. We'll report it all after the loop.
            #
            push(@bad, $host);
            push(@err_content, $res->message);
            if ($trace)
            {
                my @content = Text::Wrap::wrap('', '', $res->status_line);
                send_mail 'randyr@nafohq.hp.com',
                    "Mirror error to $host", [@content];
            }
        }
        else
        {
            write_log_line($tfile,
                           sprintf("$cmd [$$] [%s] Package propagated to " .
                                   "$host", (scalar localtime time)))
                if ($trace & 2);
            write_log_line("$config->{LOGGING_DIR}/$cmd",
                           sprintf("%s [$$] Package propagated to $host",
                                   scalar localtime time));
        }
    }

    return (wantarray) ? (0, \@bad, \@err_content) : 0
        if (scalar @bad);
    1;
}