#!/home/perforce/bin/perl
#-*-mode:perl-*-
#***************************************************************************
#
#
#***************************************************************************
#
#         File : p4review.pl
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : p4review.pl is not cutting it.  The plan is to expand the
#                the review dameon and its functionality to send email to
#                users according to the parameters of the JobView in their
#                User Specification.
#
#***************************************************************************

use Dumpvalue;
use Expect;
use File::stat;
use Getopt::Long;
use Mail::Mailer;
use P4;
use Pod::Usage;
use strict;

#
# Get arguments and options.
#
my (%opts);
GetOptions ( \%opts,
             'client=s',
             'file=s',
             'help',
             'include=s@',
             'man',
             'port=s',
             'remote=s',
             'sshpassword=s',
             'user=s'
           );

#
# Help messages.
#
pod2usage(-verbose => 1) if $opts{help};
pod2usage(-exitstatus => 0, -verbose => 2) if $opts{man};

#
# Check for required options.
#
if (not $opts{file}) {
  print "The option '--file' (-f) is required\n\n";
  pod2usage(-verbose => 1);
}

#
#Run the main program.
#
my $exit = main(%opts);

#
# Exit the script with a valid exit status.
#
exit not $exit;

#***************************************************************************
#
#     Function : main
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Main program body
#
#
#***************************************************************************
sub main {
  my (%args) = @_;

  #
  # Connect to the Perforce server.
  #
  my $p4 = p4connect(%args);
  if (not ref $p4) {
    print STDERR "Did not create an object.\n";
    return 0;
  } 

  $args{port} = $p4->GetPort();

  #
  # Secure the Perforce Protection Table
  #
  my ($protect) = readOnly($p4, %args);
  if (not ref $protect) {
    print STDERR "Did not secure the protections table\n";
    return 0;
  }

  #
  # Get a list of all the depots in the Perforce server.
  #
  my ($depots) = depots($p4, \%args);
  if (not ref $depots) {
    print STDERR "Unable to create a list of depots\n";

    #
    # Reopen the Protections Table for write.
    #
    my ($writable) = writable($p4, $protect, %args);
    if (not $writable) {
      print STDERR "Did not reopen for write the protections table\n";
      return 0;
    }

    return 0;
  }

  #
  # Do a precheckpoint verify.
  #
  my ($verify) = verify($p4, \%args);
  if (not $verify) {
    print STDERR "Perforce verify failed..\n";

    #
    # Reopen the Protections Table for write.
    #
    my ($writable) = writable($p4, $protect, %args);
    if (not $writable) {
      print STDERR "Did not reopen for write the protections table\n";
      return 0;
    }

    return 0;
  }

  #
  # Do the checkpoint.
  #
  my ($checkpoint) = checkpoint($p4, \%args);
  if (not $checkpoint) {
    print STDERR "Unable to execute a checkpoint.\n";

    #
    # Reopen the Protections Table for write.
    #
    my ($writable) = writable($p4, $protect, %args);
    if (not $writable) {
      print STDERR "Did not reopen for write the protections table\n";
      return 0;
    }

    return 0;
  }

  #
  # Tar the appropriate files.
  #
  my ($tar) = tarball($p4, $depots, %args);
  if (not $tar) {
    print STDERR "Unable to create the tarball.\n";

    #
    # Reopen the Protections Table for write.
    #
    my ($writable) = writable($p4, $protect, %args);
    if (not $writable) {
      print STDERR "Did not reopen for write the protections table\n";
      return 0;
    }

    return 0;
  }

  #
  # Reopen the Protections Table for write.
  #
  my ($writable) = writable($p4, $protect, %args);
  if (not $writable) {
    print STDERR "Did not reopen for write the protections table\n";
    return 0;
  }
  $p4->Final();

  #
  # Copy the file to the the remote server.
  #
  if ($args{remote}) {
    my ($scopy) = scopy(\%args);
    if ($scopy != 1) {
      print STDERR "Unable to securely copy the tar file to the remote server.\n";
      return 0;
    }
  }

  #
  # Close the connection to the Peforce server and
  # send an email confirming the completion of the 
  # backup task.
  #
  $args{message} = "The back up of the Perforce server at $args{port} completed successfully.\n";
  sendMail (%args);

  return 1;
}

 #***************************************************************************
#
#     Function : sendMail
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Send the email message.
#
#
#***************************************************************************
sub sendMail {
    my (%args) = @_;

    my $mailer = Mail::Mailer->new();
    $mailer->open({ From    => 'Perforce Backup <perfroce@reshape.com>',
                    To      => 'Perforce Administration <perforce@reshape.com>',
                    Subject => 'Perforce Backup Script Status'
                  });
    print $mailer $args{message};
    $mailer->close;

    return 1;
}

#***************************************************************************
#
#     Function : connect
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Connect to the perforce server.
#
#
#***************************************************************************
sub p4connect {    
  my (%args) = @_;

  #
  # New P4 object.
  #
  my ($p4) = P4->new();
  $p4->ParseForms();

  #
  # Set connection strings.
  #
  $p4->SetUser($args{user}) if $args{user};
  $p4->SetPort($args{port}) if $args{port};
  $p4->SetClient($args{client}) if $args{client};

  $p4->Init() || die "Unable to initialize a connection to the Perforce Server at " . $p4->GetPort() . "\n";
  if ($p4->ErrorCount > 0) {
    $args{message} = "Failed to connect to Perforce Server at " . $p4->GetPort() . "\n";
    $args{message} .= join "", @{$p4->Errors};
    sendMail (%args);
    return 0;
  }

  return $p4;
}

#***************************************************************************
#
#     Function : p4protect
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Secure the protections table and make all depots read only.
#
#
#***************************************************************************
sub readOnly {
  my ($p4) = shift;
  my (%args) = @_;

  #
  # Get a copy of the Protections Table.
  #
  my ($protect) = $p4->Protect('-o');
#  Dumpvalue->new->dumpValue($protect);
#  print "\n\n";
  
  #
  # Save the current table and make the depots
  # read only.
  #
  my (@protect) = @{$protect->{'Protections'}};
  push (@{$protect->{'Protections'}}, 'open user * * //...'); 
#  Dumpvalue->new->dumpValue($protect);

  #
  # Submit the modified protection table.
  #
  $p4->SetInput($protect);
  $p4->Protect('-i');
  if ($p4->ErrorCount() > 0) {
    $args{message} = "Unable to submit the readonly Perforce Protections Table.\n";
    $args{message} .= join "", @{$p4->Errors()};
    $p4->Final();
    sendMail (%args);
    return 0;
  }
#  $protect = $p4->Protect('-o');
#  Dumpvalue->new->dumpValue($protect);
#  print "\n\n";


  #
  # Save this to open the depots after the backup is complete.
  #
  return \@protect;
}

#***************************************************************************
#
#     Function : depots
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Return a list of depots in the Perforce server.
#
#
#***************************************************************************
sub depots {
  my ($p4) = shift;
  my ($args)= @_;

  my ($info) = (split /: /, join ("", grep /Server root:/, $p4->Info()))[1];
  $args->{serverRoot} = $info;

  my (@depots) = map { $_ = $info . '/' . (split / /, $_)[1]} $p4->Depots();
  push (@depots, $info . '/depot') if (not defined grep /depot/, @depots);
  my (@paths);
  foreach my $depot (@depots) {
    if (-d $depot) {
      push (@paths, $depot);
    }
  }

  if (not @paths) {
    $args->{message} = "Repository does not have directories for the depots.\nReported Depots Paths:\n\t";
    $args->{message} .= join "\n\t", @depots;
    $p4->Final();
    sendMail (%{$args});
    return 0;
  }

  return \@paths;
}

#***************************************************************************
#
#     Function : verify
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Verifythe MD5 signatures in the depots.
#
#
#***************************************************************************
sub verify {
  my ($p4) = shift;
  my ($args) = @_;

  my (@verify) = $p4->Verify('-q', '//...');
  if (defined @verify) {
    $args->{message} = "Unable to execute an MD5 verify on Perforce Server:\n\t";
    $args->{message} .= join "\n\t", @verify;
    $p4->Final();
    sendMail (%{$args});
    return 0;
  }

  my (@newmd5) = $p4->Verify('-u', '//...');

  return 1;
}

#***************************************************************************
#
#     Function : checkpoint
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Does a Perforce Checkpoint.
#
#
#***************************************************************************
sub checkpoint {
  my ($p4) = shift;
  my ($args) = @_;

  my ($counter) = $p4->counter('journal');
  if ($p4->ErrorCount() > 0) {
    $args->{message} = "Unable to execute a counter on Perforce server at $args->{port}.\n";
    $args->{message} .= join "", @{$p4->Errors()};
    $p4->Final();
    sendMail (%{$args});
    return 0;
  }

  $p4->Admin('checkpoint', '-z');
  if ($p4->ErrorCount() > 0) {
    $args->{message} = "Unable to execute a checkpoint on Perforce server at $args->{port}.\n";
    $args->{message} .= join "", @{$p4->Errors()};
    $p4->Final();
    sendMail (%{$args});

  }

  #
  # Set the file names for the journal files.
  #
  $args->{checkpoint} = $args->{serverRoot} . '/checkpoint.' . $counter . '.gz';
  $counter--;
  $args->{journal} = $args->{serverRoot} . '/journal.' . $counter . '.gz';

#  print "Checkpoint: $args->{checkpoint}\n";
#  print "Journal: $args->{journal}\n";

  return 1;
}
#***************************************************************************
#
#     Function : tarball
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Creates a file list and tars them up.
#
#
#***************************************************************************
sub tarball {
  my ($p4) = shift;
  my ($depots) = shift;
  my (%args) = @_;

  #
  # Tar the files that were included in the command line.
  #
  my $command = "tar -cf $args{file}";
  if (ref ($args{include}) eq 'ARRAY') {
    foreach my $adds (@{$args{include}}) {
      $command .= " $adds";
    }
  }

  #
  # Tar the depot directories.
  #
  foreach my $depot (@{$depots}) {
    $command .= " $depot";
  }

  #
  # Pick up the new checkpoint and journal file.
  #
  $command .= " $args{checkpoint}";
  $command .= " $args{journal}";

  my (@tar) = `$command 2>&1`;

  #
  # Validate the existance of the tar file.
  #
  if (not -f $args{file}) {
    $args{message} = "The checkpoint and backup of Perforce server at $args{port} failed.\n";
    $args{message} .= "The tar file was not created.\nTar command output:\n\t";
    $args{message} .= join "\t", @tar;
    $p4->Final();
    sendMail (%args);
    return 0;
  }

  return 1;
}

#***************************************************************************
#
#     Function : writable
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Make the Perforce repository writable again.
#
#
#***************************************************************************
sub writable {
  my ($p4) = shift;
  my ($table) = shift;
  my (%args) = @_;

  #
  # Get a copy of the Protections Table.
  #
  my ($protect) = $p4->Protect('-o');
#  Dumpvalue->new->dumpValue($protect);
#  print "\n\n";
  
  #
  # Copy the the saved protections table back into the
  # Protections Table.
  #
  $protect->{'Protections'} = $table;
#  Dumpvalue->new->dumpValue($protect);
#  print "\n\n";

  #
  # Submit the modified protection table.
  #
  $p4->SetInput($protect);
  $p4->Protect('-i');
  if ($p4->ErrorCount() > 0) {
    $args{message} = "Unable to submit the writable Perforce Protections Table.\n";
    $args{message} .= join "", @{$p4->Errors()};
    $p4->Final();
    sendMail (%args);
    return 0;
  }
#  $protect = $p4->Protect('-o');
#  Dumpvalue->new->dumpValue($protect);


  #
  # Save this to open the depots after the backup is complete.
  #
  return 1;
}

#***************************************************************************
#
#     Function : scopy
#       Author : Jeremy Russell
#         Date : November 27, 2001
#
#  Description : Securely copy the backup tarball to another file server.
#
#
#***************************************************************************
sub scopy {
  my ($args) = @_;

  #
  # Calculate the time needed to copy the file.
  #
  my ($remotefile) = (split /:/, $args->{remote})[1];
  my $stat = stat($args->{file});
  my $time = int $stat->size()/(1024*1024)*5;

  #
  # Spawn a process to start the secure copy.
  #
  my ($command) = Expect->spawn("/usr/local/bin/scp $args->{file} $args->{remote}") or return "Unable to start scp: $!\n";

  #
  # Block stdout from scp.
  #
  $command->log_stdout(0);

  #
  # Wait 10 seconds for password to appear.
  #
  unless ($command->expect(10, '-re', 'password')) {
    #
    # Otherwise timeout and send an error message to the log.
    #
    $args->{message} = "The expected password prompt timed out.\n";
    sendMail (%{$args});
    return 0;
  };

  #
  # Give the password.
  #
  print $command "$args->{sshpassword}\n";

  #
  # Wait for the copy to finish.
  #
  my ($pos, $err, $match, $before, $after) = $command->expect($time, 'EOF');

  #
  # Close the command connection.
  #
  $command->soft_close();

  my ($sig) = (split /  /, `md5sum $args->{file}`)[0];

  $command = Expect->spawn("/usr/local/bin/ssh nas1 md5sum $remotefile") or die "Unable to start scp: $!\n";

  # Block stdout from scp.
  $command->log_stdout(0);

  # Wait for password to appear.
  unless (my ($pos, $err, $match, $before, $after) = $command->expect(10, "-re", 'password: ')) {
    #
    # Otherwise timeout and send an error message to the log.
    #
    $args->{message} = "The expected password for the md5 checksum prompt timed out.\n";
    sendMail (%{$args});
    return 0;
  };

  # Give the password.
  print $command "$args->{sshpassword}\n";

  # Wait for the commmand to finish running.
  my ($pos, $err, $match, $before, $after) = $command->expect($time, "-re", '[\dA-Za-z]{32}');

  $command->expect($time, 'EOF');

  #
  # Close the command connection.
  #
  $command->soft_close();

  if ($match eq $sig) {
    return 1;
  } else {
    $args->{message} = "The signatures did not match:\n";
    $args->{message} .= "\tLocal  : $sig\n";
    $args->{message} .= "\tRemote : $match\n";
    sendMail (%{$args});
    return 0;
  }
}

__END__

=head1 NAME

p4backup.pl (Perforce Checkpoint and Backup Sqcript)

=head1 SYNOPSIS

p4backup.pl
[C<--help>]
[C<--man>]
[C<--user> I<user>]
[C<--port> I<port>]
[C<--client> I<client>]
[C<--inlcude> I<file>]
[C<--file> I<tarfile>]
[C<--remote> I<server:/file/path>]
[C<--sshpassword> I<password>]

=head1 OPTION

=over 8

=item C<--help>

Print a brief help message and exits.

=item C<--man>

Output a man page.

=item C<--file>

The tarfile that will be created by the backup command.

=over 4

=item C<--file> C</home/perforce/backups/source.tar>

Create the tar file /home/perforce/backups/source.tar as the backup file.

=back

=item C<--client>

The Perforce client that will be used during the Perforce connection.

=item C<--port>

The Perforce connection data for the server to be backed up.

=item C<--user>

The Perforce user to do the backup.  This user ust have superuser rights in
Perforce.

=item C<--include>

This option can be used multiple times to specify a list of files to
be included in the Perforce backup.

=over 4

=item C<--include> C</perforce/p4d>

Include the file /perforce/p4d in the backup.

=item C<--include> C</perforce/license> C<--include> C</perforce/p4review.python>

Inlcude the files /perforce/license and /perforce/p4review.python in the backup.

=back

=item C<--remote>

This is the C<scp> supporting server which the backup files should be copied
to after the they are created.  A passowrd must be specified (C<--sshpassword>)
if the C<ssh> connection does not support .rhosts.

=over 4

=item C<--remote> C<pope:/backups>

Copy the backup tar to the directory /backups on the computer pope.

=back

=item C<--sshpassword>

The password to allow I<ssh> connections.  Can only be used with the -r option.

=over 4

=item C<--remote> C<pope:/backups> C<--sshpassword> C<mypassword>

Copy the backup tar to the directory /backups on the computer pope.

=back



=back

=head1 DESCRIPTION

This is a basic backup script for a Perforce server.  This script does a
checkpoint. It does the equivilant of a 'C<p4d -jc>'.

The script then tars the checkpoint file, the journal file, all of the
depot directories (recursively), and any files that were included
using the C<--include> option.

Do not attempt to include the log file in the tar.  If you want the log
file do not use this script.

=head1 AUTHOR

Jeremy Russell

russell_jeremy@yahoo.com

=cut