#!/usr/bin/perl
#
# IPCop CGI's - backup.cgi: manage import/export of configuration files
#
# This code is distributed under the terms of the GPL
#
# (c) The IPCop Team
# 2005 Franck Bourdonnec, major rewrite
#
# $Id: backup.cgi,v 1.2.2.15 2006/01/29 15:31:49 eoberlander Exp $
#
#
# to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
# use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
# next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
#use warnings;
use strict;
#use Carp ();
#local $SIG{__WARN__} = \&Carp::cluck;
use File::Copy;
use Sys::Hostname;
require 'CONFIG_ROOT/general-functions.pl';
require "${General::swroot}/lang.pl";
require "${General::swroot}/header.pl";
my $errormessage = '';
my $warnmessage = '';
my $setdir = '/home/httpd/html/backup'; # location where sets are stored and imported
my $datafile = hostname() . '.dat'; # file containing data backup
my $datefile = $datafile . '.time'; # and creation date
# ask if backup crypting key exists
my $tmpkeyfile = "$setdir/key"; # import the backup key
# Get GUI values
my %settings = ();
&Header::getcgihash(\%settings, {'wantfile' => 1, 'filevar' => 'FH'});
##
## Backup key management
##
#
# Export the key. root pw is required to avoid user 'noboby' uses the helper to read it and creates
# fake backup.
#
if ($settings{'ACTION'} eq $Lang::tr{'backup export key'}) {
my $size = 0;
if ($settings{'PASSWORD1'} ne '' && $settings{'PASSWORD1'} ne $settings{'PASSWORD2'} ){
$errormessage = $Lang::tr{'passwords do not match'}
} else {
my @lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}`;
# If previous operation succeded and the key need to be crypted, redo operation with pipe to openssl
if (@lines && $settings{'PASSWORD1'}) {
@lines = `/usr/local/bin/ipcopbackup -keycat $settings{'PASSWORD'}|openssl enc -a -e -aes256 -salt -pass pass:$settings{'PASSWORD1'} `;
}
if (@lines) {
use bytes;
foreach (@lines) {$size += length($_)};
print "Pragma: no-cache\n";
print "Cache-control: no-cache\n";
print "Connection: close\n";
print "Content-type: application/octet-stream\n";
print "Content-Disposition: filename=backup.key\n";
print "Content-Length: $size\n\n";
print @lines;
exit (0);
} else {
$errormessage = $Lang::tr{'incorrect password'};
}
}
}
#
# Import the key. Fail if key exists. This avoid creating fake backup.
#
if ($settings{'ACTION'} eq $Lang::tr{'backup import key'}) {
if (ref ($settings{'FH'}) ne 'Fh') {
$errormessage = $Lang::tr{'no cfg upload'};
} else {
if (copy ($settings{'FH'}, $tmpkeyfile) != 1) {
$errormessage = $Lang::tr{'save error'};
} else {
# if a password is given, decrypt the key received in $tmpkeyfile file with it.
# no error is produce if the password is wrong.
if ($settings{'PASSWORD1'}) {
my @lines = `openssl enc -a -d -aes256 -salt -pass pass:$settings{'PASSWORD1'} -in $tmpkeyfile`;
open(FILE,">$tmpkeyfile");
print FILE @lines;
close (FILE);
}
$errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);
}
}
}
#
# Import the key. Fail if key exists. Key is extracted from a non-encrypted backup (pre 1.4.10)
#
if ($settings{'ACTION'} eq $Lang::tr{'backup extract key'}) {
if (ref ($settings{'FH'}) ne 'Fh') {
$errormessage = $Lang::tr{'no cfg upload'};
} else {
if (copy ($settings{'FH'}, '/tmp/tmptarfile.tgz') != 1) {
$errormessage = $Lang::tr{'save error'};
} else {
system( "tar -C /tmp -xzf /tmp/tmptarfile.tgz */backup/backup.key;\
mv -f /tmp${General::swroot}/backup/backup.key $tmpkeyfile;\
rm -rf /tmp${General::swroot};\
rm /tmp/tmptarfile.tgz");
$errormessage = &get_bk_error(system ('/usr/local/bin/ipcopbackup -key import')>>8);
}
}
}
#
# Create the key. Cannot overwrite existing key to avoid difference with exported (saved) key
#
if ($settings{'ACTION'} eq $Lang::tr{'backup generate key'}) {
$errormessage = &get_bk_error(system('/usr/local/bin/ipcopbackup -key new')>>8);
}
my $cryptkeymissing = system ('/usr/local/bin/ipcopbackup -key exist')>>8;
&Header::showhttpheaders();
if ($cryptkeymissing) { #If no key is present, force creation or import
&Header::openpage($Lang::tr{'backup configuration'}, 1, '');
&Header::openbigbox('100%', 'left', '', $errormessage);
if ($errormessage) {
&Header::openbox('100%', 'left', $Lang::tr{'error messages'});
print "$errormessage ";
&Header::closebox();
}
&Header::openbox('100%', 'left', $Lang::tr{'backup key'});
print <
$Lang::tr{'backup explain key'}:
$Lang::tr{'backup explain key li1'}
$Lang::tr{'backup explain key li2'}
$Lang::tr{'backup explain key li3'}
$Lang::tr{'backup key file'}:
$Lang::tr{'backup protect key password'}:
$Lang::tr{'backup clear archive'}:
$Lang::tr{'notes'}:
$Lang::tr{'backup explain key no1'}
$Lang::tr{'backup explain key no2'}
END
;
&floppybox();
&Header::closebox();
&Header::closebigbox();
&Header::closepage();
exit (0);
}
##
## Sets management (create/delete/import/restore)
##
erase_files ($setdir); #clean up
#
# create new archive set
#
if ($settings{'ACTION'} eq $Lang::tr{'create'}) {
$errormessage = &get_bk_error(system('/usr/local/bin/ipcopbkcfg > /dev/null')>>8);
&import_set (" ".&Header::cleanhtml ($settings{'COMMENT'})) if (!$errormessage);
}
#
# delete a backup set
#
if ($settings{'ACTION'} eq $Lang::tr{'remove'}) {
erase_files (&Header::cleanhtml ($settings{'KEY'})); # remove files
rmdir($settings{'KEY'}); # remove directory
}
#
# import an archive set
#
if ($settings{'ACTION'} eq $Lang::tr{'import'}) {
if (ref ($settings{'FH'}) ne 'Fh') {
$errormessage = $Lang::tr{'no cfg upload'};
} else {
if (!copy ($settings{'FH'}, "$setdir/$datafile")) {
$errormessage = $Lang::tr{'save error'};
} else {
&import_set (' (imported)');
}
}
}
#
# restore an archive
#
if ($settings{'ACTION'} eq $Lang::tr{'restore'}) {
if ($settings{'AreYouSure'} eq 'yes') {
if (!$cryptkeymissing) { # if keyfile exists
if (-e "$settings{'KEY'}/$datafile"){ # encrypted dat is required
copy_files($settings{'KEY'}, $setdir); # to working dir
$errormessage = get_rs_error(system("/usr/local/bin/ipcoprscfg"
. ($settings{'RESTOREHW'} eq 'on' ? ' --hardware' : '')
. ' >/dev/null')>>8);
if (!$errormessage) {
# restored ok, recommend restarting system
$warnmessage = $Lang::tr{'cfg restart'};
}
erase_files ($setdir); #clean up
} else {
$errormessage = $Lang::tr{'missing dat'}."$settings{'KEY'}/$datafile";
}
} else { # if keyfile does not exist
$errormessage = $Lang::tr{'backup missing key'};
}
} else { # not AreYouSure=yes
&Header::openpage($Lang::tr{'backup configuration'}, 1, '');
&Header::openbigbox('100%', 'left');
&Header::openbox('100%', 'left', $Lang::tr{'are you sure'});
print <
$Lang::tr{'restore hardware settings'}:
END
;
&Header::closebox();
&Header::closebigbox();
&Header::closepage();
exit (0);
}
}
##
## Media management
##
#
# now build the list of removable device
#
# Read partitions sizes registered with the system
my %partitions;
foreach my $li (`/usr/local/bin/ipcopbackup -proc partitions`) { # use suid helper...
# partitions{'sda1'} = 128M if /major minor blocks name/
$partitions{$4} = &kmgt($3*1024,4) if ($li =~ /(\d+) +(\d+) +(\d+) +(.*)/);
}
# Search usb-storage scsi device
my %medias;
foreach (`/usr/local/bin/ipcopbackup -glob '/proc/scsi/usb-storage*/*'`) {# use suid helper...
my $m;
foreach ( `cat $_` ) { # list each line of information for the device:
# Host scsi0: usb-storage
# Vendor: SWISSBIT
# Product: Black Silver
# Serial Number: D0ED423A4F84A31E
# Protocol: Transparent SCSI
# Transport: Bulk
# GUID: 13706828d0ed423a4f84a31e
# Attached: Yes
chomp;
my ($key,$val) = split(': ',$_,2);
$key =~ s/^ *//; # remove front space
# convert 'scsi?' key to sda, sdb,... and use it as a %medias keyhash
if ($key =~ /Host scsi(.)/) {
$val = $m = 'sd' . chr(97+$1);
$key = 'Host';
}
$medias{$m}{$key} = $val; # save data
}
}
#
# Switch mounted media
#
if ($settings{'ACTION'} eq $Lang::tr{'mount'})
{
# Find what is really mounted under backup. Can be local hard disk or any removable media
my $mounted = &findmounted();
#umount previous, even if same device already mouted.
system ("/usr/local/bin/ipcopbackup -U $mounted") if ($mounted ne $Lang::tr{'local hard disk'});
$errormessage = `/usr/local/bin/ipcopbackup -M $settings{'SELECT'}` if (grep (/$settings{'SELECT'}/,%partitions));
}
#
# Compute a full description of device
#
my $mounted = &findmounted();
my $media_des = $mounted; # Description
if ($mounted ne $Lang::tr{'local hard disk'}) {
$_ = $mounted; # sda1 => sda
tr/0-9//d;
$media_des = "$medias{$_}{'Product'} ($media_des, $partitions{$mounted})";
}
&Header::openpage($Lang::tr{'backup configuration'}, 1, '');
&Header::openbigbox('100%', 'left', '', $errormessage);
if ($errormessage) {
&Header::openbox('100%', 'left', $Lang::tr{'error messages'});
print "$errormessage ";
&Header::closebox();
}
$warnmessage = "$Lang::tr{'capswarning'}: $warnmessage
" if ($warnmessage);
&Header::openbox('100%', 'left', $Lang::tr{'backup configuration'});
#Divide the window in two : left and right
print <
$Lang::tr{'current media'}:$media_des
$Lang::tr{'choose media'}
END
;
# Left part of window
print <
$Lang::tr{'backup sets'}:
$Lang::tr{'name'}
$Lang::tr{'action'}
END
;
# get list of available sets by globbing directories under $setdir
# External device (usk key) are mounted in $setdir. -R permits finding sets in hierarchy.
my $i = 0;
foreach my $set (`ls -Rt1 $setdir`) {
chop ($set); #remove ':' & newline from line
chop ($set);
if (-d $set && ($set =~ m!/.+/\d{8}_\d{6}! ) ) { # filter out things not sets !
if ($i++ % 2) {
print "
";
} else {
print "
";
}
my $settime = read_timefile( "$set/$datefile", "$set/$datafile" );
my $name = substr ($set,length($setdir)+1);
print<
$settime
' if ($settings{'ACTION'} eq $Lang::tr{'backup to floppy'} );
}
# Return device name of what is mounted under 'backup'
sub findmounted() {
my $mounted = `mount|grep ' /home/httpd/html/backup '`;
if ($mounted) { # extract device name
$mounted =~ m!^/dev/(.*) on!; # device on mountmoint options
return $1;
} else { # it's the normal subdir
return $Lang::tr{'local hard disk'};
}
}
# read and return a date/time string from a time file
sub read_timefile() {
my $fname = shift; # name of file to read from
my $fname2 = shift; # if first file doesn't exist, get date of this file
my $dt;
if (defined(open(FH, "<$fname"))) {
$dt = ;
chomp $dt;
close(FH);
} else {
$dt = &get_fdate($fname2); # get file date/time
write_timefile($fname, $dt); # write to expected time file
}
return $dt;
}
# write a date/time string to a time file
sub write_timefile() {
my $fname = shift; # name of file to write to
my $dt = shift; # date/time string to write
if (open(FH, ">$fname")) {
print FH "$dt\n";
close(FH);
}
}
# move a dat file without time stamp to subdir
sub import_set() {
my $dt = get_fdate("$setdir/$datafile") . shift;
&write_timefile("$setdir/$datefile", $dt);
# create set directory
my $setname = "$setdir/" . get_ddate("$setdir/$datafile");
mkdir($setname);
# move files to the new set directory
copy_files($setdir, $setname);
erase_files ($setdir);
}
# get date/time string from file
sub get_fdate() {
my $fname = shift;
open(DT, "/bin/date -r $fname|");
my $dt =
;
close(DT);
chomp $dt;
$dt =~ s/\s+/ /g; # remove duplicate spaces
return $dt;
}
# get date/time string from file for use as directory name
sub get_ddate() {
my $fname = shift;
open(DT, "/bin/date -r $fname +%Y%m%d_%H%M%S|");
my $dt =