source: trunk/soft/scripts/transfert @ 42

#!/usr/bin/perl

# $Id$

=head1 NAME

transfert - A script to transfert data using rsync

=head1 VERSION

CVS: $Revision$

=cut

use strict;
use warnings;
use Getopt::Long;
use Config::IniFiles;
use Mail::Sendmail;
use POSIX qw(strftime);
use Pod::Usage;
use Digest::MD5;

# 0 .. 6 => debug, info, report, warn, error, die
my $verbose = 1;

GetOptions(
    'config|c=s' => \my $configfile,
    'v' => sub { $verbose-- },
    'd|debug' => \my $debug,
    'nomail' => \my $nomail,
    'mailto' => \my $mailto,
    'logfile=s' => \my $logfile,
    'help|h' => sub { pod2usage(-exitval => 0) },
) or pod2usage();

=head1 SYNOPSIS

transfert -c <configfile> [...]

    config|c <configfile>   use this config file
    v                       increase verbosity
    nomail                  do not sent any mail
    logfile <logfilefmt>    write log into this file
    help|h                  print this message
    debug|d                 debug mode

=head1 OPTIONS

=head1 CONFIGURATION FILE

=head2 Description

The configuration is an INI file like. Each section describe
a path to transfert. The section named 'default' is used to store
global or default values.

Example:

    [default]

    [musique]
    source=/source/
    dest=host:/dest
    mailto=user@domain

=head2 Globals values

Following paramater should be set into [default] section:

=over

=item * smtp Mail host to use to send mail, default is 'localhost'

=item * mailfrom the mail adress set into mail as from, only the form
user@domain should appear

=item * mailheader a message to copy at the beggining of each mail

=item * mailfooter a message to copy at the end of each mail

=item * logfile redirect log into this file.

logfile is a strftime format. See L<strftime> man page, or L<POSIX>
perl module documentation.

=head2 Per transfert parameters

All this paramter can be set into [default] section

=item * source the source file to transfert. 

This paramater is passed directly to rsync, so can be a glob.

=item * destination the destination where file should be copied

=item * cmd the command to use to trnsfert files

=item * mailto the list of coma separate mail address which will receive 
transfert log

=item * postrun a command to run for each file, %s is replaced by the path
of the file

=back
    
=cut

$verbose = 0 if ($debug);
my $maillog; # mail => { level =>, msg => @}
my $logcallback = undef;
my $loghandle = \*STDERR;

if (!$configfile) {
    loging(6, "No config file given");
    exit(1);
}

loging(0, "Reading config '%s'", $configfile);
my $config = new Config::IniFiles(
            -file => $configfile,
            -default => 'default',
            -allowcontinue => 1
);

if (!($config && -f $configfile && -r _)) {
    loging(6, "Can't open %s", $configfile);
    exit(1);
}

$logfile ||= $config->val('default', 'logfile');
if ($logfile) {
    loging(0, "Openning log file %s (%s)", strftime($logfile, gmtime), $logfile);
    if (!open($loghandle, '> ' . strftime($logfile, gmtime))) {
        $loghandle = \*STDERR;
        loging(5, "Can't open log file %s (%s)", strftime($logfile, gmtime), $logfile);
    }
}


foreach my $entry ($config->Sections) {
    $entry eq 'default' and next;
    loging(0, "Starting section '%s'", $entry);
    my @mail = split(/\s*,\s*/, $config->val($entry, 'mailto'));
    loging(0, "mail to '%s' in section '%s'", $config->val($entry, 'mailto') || "", $entry);
    loging(0, "after filter, mail sent to %s in section '%s'",
        join(", ", map { "'$_'" } @mail), $entry);
    
    $logcallback = sub {
        my ($level, $msg) = @_;
        foreach (@mail) {
            push(@{$maillog->{$_}}, "[$level] $msg");
        }         
    } unless($nomail);
    
    transfert($entry);
    $logcallback = undef;
    send_mail() unless($nomail);
    
}

loging(0, "End of transfert, exiting");
close($loghandle);
exit(0);

#################
# MAIN LOOP END #
#################

sub loging {
    my ($level, $fmt, @val) = @_;
    my $msg = sprintf($fmt, @val);
    if($level >= 0 && $level >= $verbose) {
        if ($logcallback) {
            $logcallback->($level, $msg);
        }
        if (!$logcallback || $debug) {
            print $loghandle "[$level] $msg\n";
        }
    }
    $msg
}

=head1 DATA TRANSFERT

=head2 Finding files

The scripts look for L<source> parameter, if it is a directory, the script
perform a glob using 'source/*', otherwise, it perform a glob using directly
the source parameter

If the source parameter is not defined, the script log an error and skip the
section.

The second required parameter is the destination of files, L<dest> parameter
in config files. It should be accepted by the L<cmd> program that will
transfert data, the form "user@host:/path" is generally use as the default
program is rsync.

For each files found according L<source> parameter:

- we look if a .md5sum exists (using file name as prefix) and if it is more
recent, if yes, we assume file has been already transfered.

- a .md5sum is create, this files contains some comment and the md5sum of
the data file, this .md5sum can be used by md5sum -c to check data file
integrity

- both data file and its md5sum file are tranfered, if tranfer failed, the
md5sum file is deleted

- L<postrun> command is run for both data file and its md5sum file if tranfert
is succefully completed.

=cut

sub transfert {
    my ($entry) = @_;
    my $source = $config->val($entry, 'source') or do {
        loging(5, "No source defined for %s", $entry);
        return 0;
    };

    my $dest = $config->val($entry, 'dest') or do {
        loging(5, "No destination defined for %s", $entry);
        return 0;
    };

    my @files = -d $source ? glob("$source/*") : glob($source);
    my @datafiles;
    
    foreach my $f (@files) {
        if ($f =~ /.md5sum$/) {
            loging(0, "%s is md5sum file, skipping", $f);
            next;
        }
        
        if (! -f $f) {
            loging(0, "%s is not a regular file, skipping", $f);
            next;
        }
        my ($fsize, $ftime);
        {
            my @st = stat($f);
            $fsize = $st[7];
            $ftime = $st[9];
        }
        
        # Does the transfert need
        if (-f "$f.md5sum") {
            if ((stat("$f.md5sum"))[9] > $ftime) {
                loging(0, "%s exists and is newer, assume transfert is not need", "$f.md5sum");
                next;
            }
        }
        
        # Creating md5sum file
        if(open(my $md5h, "> $f.md5sum")) {
            if (open(my $fh, "< $f")) {
                loging(0, "Creating %s md5 file", "$f.md5sum");
                binmode($fh);
                my $md5 = new Digest::MD5;
                $md5->addfile($fh);
                printf $md5h 
                        "# %s\n# %s (%d octets)\n# %s\n%s  %s\n",
                        q$Id$,
                        $f, $fsize,
                        scalar(localtime),
                        $md5->hexdigest,
                        ($f =~ m!(?:.*/)?(.*)$!)[0];
                close($fh);
            } else {
                login(5, "Can't open %s for reading", $f);
            }
            close($md5h);
        } else {
            login(5, "Can't open %s for writting", "$f.md5sum");
        }

        my $error = 0;
        foreach my $filetotranfert (grep { -f $_ } ("$f.md5sum", $f)) {
            my $cmd = sprintf(
                "%s %s %s",
                $config->val($entry, 'cmd', 'rsync -e ssh'),
                $filetotranfert,
                $dest,
            );
            loging(0, "running `%s'", $cmd);
            if (system($cmd)) {
                loging(4, "tranfert failed for %s, exit code: %d", $filetotranfert, $? >> 8);
                unlink("$f.md5sum"); # ensure transfert will be retried
                $error++;
            }
        }
        
        if ($error) {
            loging(5, "Failed to transfert %s", $f);
            next;
        } else {
            loging(1, "%s (%d) transfer ok", $f, $fsize);
            push(@datafiles, { file => $f, size => $fsize });
        }

        # No error running action:
        if (my $postrun = $config->val($entry, 'postrun')) {
            loging(0, "found postrun: %s for %s", $postrun || '(unset)', $entry);
            foreach my $filetotranfert (grep { -f $_ } ("$f.md5sum", $f)) {
                my $fpostrun = sprintf($postrun, $filetotranfert);
                loging(0, "Running `%s'", $fpostrun);
                my $postrunres = system($fpostrun);
                loging(0, "Postrun exit: %d", $postrunres);
            }
        }
    }

    my $totalsize = 0;
    $totalsize += $_->{size} foreach (@datafiles);
    loging(2, "%s: %d file transmit, %d octets", $entry, scalar(@datafiles), $totalsize);
    
    return 0;
}


sub send_mail {
    foreach $mailto (keys %${maillog}) {
        my %mail = (
            To => $mailto,
            Subject => "Data transfert report",
            'X-Mailer' => "Data transfert",
            'X-OSBDATA-HOST' => "",
            Smtp => $config->val('default', 'smtp', 'localhost'),
            From => 'Data transfert bot <' . $config->val(
                'default', 
                'mailfrom',
                'olivier.thauvin@aerov.jussieu.fr') .'>',

        );
        $mail{message} = "";
        $mail{message} .= $config->val('default', 'mailheader', '');
        $mail{message} .= "$_\n" foreach (@{$maillog->{$mailto}});
        $mail{message} .= $config->val('default', 'mailfooter', '');
        my $hostname = `hostname`; chomp($hostname);
        $mail{message} .= sprintf(
            "\n-- \nMail sent by transfert bot on %s\n%s\n",
            $hostname,
            q$Id$,
        );
        
        sendmail(%mail) or loging(5, "Can't sent mail to %s: %s", $mailto, $Mail::Sendmail::error);
    }
}

__END__

=head1 AUTHOR

Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>

=head1 CHANGELOG

    $Log$
    Revision 1.9  2005/11/22 07:48:49  thauvin
    - update doc

    Revision 1.8  2005/11/21 19:11:49  thauvin
    - add signature in mail

    Revision 1.7  2005/11/21 18:44:07  thauvin
    - put relative path to file for md5sum

    Revision 1.6  2005/11/21 18:04:46  thauvin
    - rework transfert, create md5sum file

    Revision 1.5  2005/11/18 18:40:27  thauvin
    - add postrun doc

    Revision 1.4  2005/11/18 18:29:08  thauvin
    - add postrun function

    Revision 1.3  2005/11/08 18:40:43  thauvin
    - add documentation

    Revision 1.2  2005/11/08 17:17:29  thauvin
    - add logfile support