#!/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