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