]>
git.ipfire.org Git - people/ms/ipfire-2.x.git/blob - html/cgi-bin/backup.cgi
3 # IPCop CGI's - backup.cgi: manage import/export of configuration files
5 # This code is distributed under the terms of the GPL
8 # 2005 Franck Bourdonnec, major rewrite
10 # $Id: backup.cgi,v 1.2.2.15 2006/01/29 15:31:49 eoberlander Exp $
15 # to fully troubleshot your code, uncomment diagnostics, Carp and cluck lines
16 # use diagnostics; # need to add the file /usr/lib/perl5/5.8.x/pods/perldiag.pod before to work
17 # next look at /var/log/httpd/error_log , http://www.perl.com/pub/a/2002/05/07/mod_perl.html may help
21 #local $SIG{__WARN__} = \&Carp::cluck;
25 require 'CONFIG_ROOT/general-functions.pl' ;
26 require "${General::swroot}/lang.pl" ;
27 require "${General::swroot}/header.pl" ;
29 my $errormessage = '' ;
31 my $setdir = '/home/httpd/html/backup' ; # location where sets are stored and imported
32 my $datafile = hostname
() . '.dat' ; # file containing data backup
33 my $datefile = $datafile . '.time' ; # and creation date
35 # ask if backup crypting key exists
36 my $tmpkeyfile = " $setdir /key" ; # import the backup key
40 & Header
:: getcgihash
( \
%settings , { 'wantfile' => 1 , 'filevar' => 'FH' });
43 ## Backup key management
47 # Export the key. root pw is required to avoid user 'noboby' uses the helper to read it and creates
50 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'backup export key' }) {
53 if ( $settings { 'PASSWORD1' } ne '' && $settings { 'PASSWORD1' } ne $settings { 'PASSWORD2' } ){
54 $errormessage = $Lang :: tr
{ 'passwords do not match' }
56 my @lines = `/usr/local/bin/ipcopbackup -keycat $settings {'PASSWORD'}` ;
57 # If previous operation succeded and the key need to be crypted, redo operation with pipe to openssl
58 if ( @lines && $settings { 'PASSWORD1' }) {
59 @lines = `/usr/local/bin/ipcopbackup -keycat $settings {'PASSWORD'}|openssl enc -a -e -aes256 -salt -pass pass: $settings {'PASSWORD1'} ` ;
63 foreach ( @lines ) { $size += length ( $_ )};
64 print "Pragma: no-cache \n " ;
65 print "Cache-control: no-cache \n " ;
66 print "Connection: close \n " ;
67 print "Content-type: application/octet-stream \n " ;
68 print "Content-Disposition: filename=backup.key \n " ;
69 print "Content-Length: $size \n\n " ;
73 $errormessage = $Lang :: tr
{ 'incorrect password' };
78 # Import the key. Fail if key exists. This avoid creating fake backup.
80 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'backup import key' }) {
81 if ( ref ( $settings { 'FH' }) ne 'Fh' ) {
82 $errormessage = $Lang :: tr
{ 'no cfg upload' };
84 if ( copy
( $settings { 'FH' }, $tmpkeyfile ) != 1 ) {
85 $errormessage = $Lang :: tr
{ 'save error' };
87 # if a password is given, decrypt the key received in $tmpkeyfile file with it.
88 # no error is produce if the password is wrong.
89 if ( $settings { 'PASSWORD1' }) {
90 my @lines = `openssl enc -a -d -aes256 -salt -pass pass: $settings {'PASSWORD1'} -in $tmpkeyfile ` ;
91 open ( FILE
, "> $tmpkeyfile " );
95 $errormessage = & get_bk_error
( system ( '/usr/local/bin/ipcopbackup -key import' )>> 8 );
100 # Import the key. Fail if key exists. Key is extracted from a non-encrypted backup (pre 1.4.10)
102 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'backup extract key' }) {
103 if ( ref ( $settings { 'FH' }) ne 'Fh' ) {
104 $errormessage = $Lang :: tr
{ 'no cfg upload' };
106 if ( copy
( $settings { 'FH' }, '/tmp/tmptarfile.tgz' ) != 1 ) {
107 $errormessage = $Lang :: tr
{ 'save error' };
109 system ( "tar -C /tmp -xzf /tmp/tmptarfile.tgz */backup/backup.key;\
110 mv -f /tmp${General::swroot}/backup/backup.key $tmpkeyfile ;\
111 rm -rf /tmp${General::swroot};\
112 rm /tmp/tmptarfile.tgz" );
113 $errormessage = & get_bk_error
( system ( '/usr/local/bin/ipcopbackup -key import' )>> 8 );
118 # Create the key. Cannot overwrite existing key to avoid difference with exported (saved) key
120 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'backup generate key' }) {
121 $errormessage = & get_bk_error
( system ( '/usr/local/bin/ipcopbackup -key new' )>> 8 );
124 my $cryptkeymissing = system ( '/usr/local/bin/ipcopbackup -key exist' )>> 8 ;
126 & Header
:: showhttpheaders
();
127 if ( $cryptkeymissing ) { #If no key is present, force creation or import
128 & Header
:: openpage
( $Lang :: tr
{ 'backup configuration' }, 1 , '' );
129 & Header
:: openbigbox
( '100%' , 'left' , '' , $errormessage );
131 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'error messages' });
132 print "<font class='base'> $errormessage </font>" ;
135 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'backup key' });
137 <form method = 'post' enctype = 'multipart/form-data'>
141 $Lang ::tr{'backup explain key'}:
143 <li> $Lang ::tr{'backup explain key li1'}
144 <li> $Lang ::tr{'backup explain key li2'}
145 <li> $Lang ::tr{'backup explain key li3'}
149 <td width='15%'></td><td width='20%'></td><td>
150 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'backup generate key'}' />
153 <td align='right'> $Lang ::tr{'backup key file'}:</td><td><input type = 'file' name = 'FH' size = '30' value='backup.key' />
155 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'backup import key'}' />
157 <td align='right'> $Lang ::tr{'backup protect key password'}:<td><input type = 'password' name='PASSWORD1' size='10' />
160 <td align='right'> $Lang ::tr{'backup clear archive'}:</td><td><input type = 'file' name = 'FH' size = '30' value='your-ipcop.tar.gz' />
162 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'backup extract key'}' />
168 <li> $Lang ::tr{'backup explain key no1'}
169 <li> $Lang ::tr{'backup explain key no2'}
176 & Header
:: closebigbox
();
177 & Header
:: closepage
();
182 ## Sets management (create/delete/import/restore)
185 erase_files
( $setdir ); #clean up
188 # create new archive set
190 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'create' }) {
191 $errormessage = & get_bk_error
( system ( '/usr/local/bin/ipcopbkcfg > /dev/null' )>> 8 );
192 & import_set
( " " .& Header
:: cleanhtml
( $settings { 'COMMENT' })) if (! $errormessage );
195 # delete a backup set
197 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'remove' }) {
198 erase_files
(& Header
:: cleanhtml
( $settings { 'KEY' })); # remove files
199 rmdir ( $settings { 'KEY' }); # remove directory
202 # import an archive set
204 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'import' }) {
205 if ( ref ( $settings { 'FH' }) ne 'Fh' ) {
206 $errormessage = $Lang :: tr
{ 'no cfg upload' };
208 if (! copy
( $settings { 'FH' }, " $setdir / $datafile " )) {
209 $errormessage = $Lang :: tr
{ 'save error' };
211 & import_set
( ' (imported)' );
218 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'restore' }) {
219 if ( $settings { 'AreYouSure' } eq 'yes' ) {
220 if (! $cryptkeymissing ) { # if keyfile exists
221 if (- e
" $settings {'KEY'}/ $datafile " ){ # encrypted dat is required
222 copy_files
( $settings { 'KEY' }, $setdir ); # to working dir
223 $errormessage = get_rs_error
( system ( "/usr/local/bin/ipcoprscfg"
224 . ( $settings { 'RESTOREHW' } eq 'on' ?
' --hardware' : '' )
225 . ' >/dev/null' )>> 8 );
226 if (! $errormessage ) {
227 # restored ok, recommend restarting system
228 $warnmessage = $Lang :: tr
{ 'cfg restart' };
230 erase_files
( $setdir ); #clean up
232 $errormessage = $Lang :: tr
{ 'missing dat' }. " $settings {'KEY'}/ $datafile " ;
234 } else { # if keyfile does not exist
235 $errormessage = $Lang :: tr
{ 'backup missing key' };
238 } else { # not AreYouSure=yes
239 & Header
:: openpage
( $Lang :: tr
{ 'backup configuration' }, 1 , '' );
240 & Header
:: openbigbox
( '100%' , 'left' );
241 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'are you sure' });
243 <form method = 'post'>
244 <input type = 'hidden' name = 'KEY' value =' $settings {'KEY'}' />
245 <input type = 'hidden' name = 'AreYouSure' value ='yes' />
246 <table align = 'center'>
248 <td align = 'center'>
249 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'restore'}' />
251 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'cancel'}' />
255 $Lang ::tr{'restore hardware settings'}: <input type = 'checkbox' name = 'RESTOREHW'>
263 & Header
:: closebigbox
();
264 & Header
:: closepage
();
272 # now build the list of removable device
275 # Read partitions sizes registered with the system
277 foreach my $li ( `/usr/local/bin/ipcopbackup -proc partitions` ) { # use suid helper...
278 # partitions{'sda1'} = 128M if /major minor blocks name/
279 $partitions { $4 } = & kmgt
( $3 * 1024 , 4 ) if ( $li =~ /(\d+) +(\d+) +(\d+) +(.*)/ );
282 # Search usb-storage scsi device
285 foreach ( `/usr/local/bin/ipcopbackup -glob '/proc/scsi/usb-storage*/*'` ) { # use suid helper...
287 foreach ( `cat $_ ` ) { # list each line of information for the device:
288 # Host scsi0: usb-storage
290 # Product: Black Silver
291 # Serial Number: D0ED423A4F84A31E
292 # Protocol: Transparent SCSI
294 # GUID: 13706828d0ed423a4f84a31e
298 my ( $key , $val ) = split ( ': ' , $_ , 2 );
299 $key =~ s/^ *// ; # remove front space
301 # convert 'scsi?' key to sda, sdb,... and use it as a %medias keyhash
302 if ( $key =~ /Host scsi(.)/ ) {
303 $val = $m = 'sd' . chr ( 97 + $1 );
306 $medias { $m }{ $key } = $val ; # save data
311 # Switch mounted media
313 if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'mount' })
315 # Find what is really mounted under backup. Can be local hard disk or any removable media
316 my $mounted = & findmounted
();
317 #umount previous, even if same device already mouted.
318 system ( "/usr/local/bin/ipcopbackup -U $mounted " ) if ( $mounted ne $Lang :: tr
{ 'local hard disk' });
319 $errormessage = `/usr/local/bin/ipcopbackup -M $settings {'SELECT'}` if ( grep ( /$settings{'SELECT'}/ , %partitions ));
322 # Compute a full description of device
324 my $mounted = & findmounted
();
325 my $media_des = $mounted ; # Description
326 if ( $mounted ne $Lang :: tr
{ 'local hard disk' }) {
327 $_ = $mounted ; # sda1 => sda
329 $media_des = " $medias { $_ }{'Product'} ( $media_des , $partitions { $mounted })" ;
331 & Header
:: openpage
( $Lang :: tr
{ 'backup configuration' }, 1 , '' );
332 & Header
:: openbigbox
( '100%' , 'left' , '' , $errormessage );
335 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'error messages' });
336 print "<font class='base'> $errormessage </font>" ;
340 $warnmessage = "<font color=${Header::colourred}><b> $Lang ::tr{'capswarning'}</b></font>: $warnmessage <p>" if ( $warnmessage );
342 & Header
:: openbox
( '100%' , 'left' , $Lang :: tr
{ 'backup configuration' });
344 #Divide the window in two : left and right
346 <table width = '100%' >
348 <th width = '50%'> $Lang ::tr{'current media'}:<font color=${Header::colourred}><b> $media_des </b></font></th>
349 <th width = '3%'></th>
350 <th> $Lang ::tr{'choose media'}</th>
355 # Left part of window
359 <li> $Lang ::tr{'backup sets'}:
360 <table width = '80%' border='0'>
362 <th class = 'boldbase' align = 'center'> $Lang ::tr{'name'}</th>
363 <th class = 'boldbase' align = 'center' colspan = '3'> $Lang ::tr{'action'}</th>
368 # get list of available sets by globbing directories under $setdir
369 # External device (usk key) are mounted in $setdir. -R permits finding sets in hierarchy.
371 foreach my $set ( `ls -Rt1 $setdir ` ) {
372 chop ( $set ); #remove ':' & newline from line
374 if (- d
$set && ( $set =~ m!/.+/\d{8}_\d{6}! ) ) { # filter out things not sets !
376 print "<tr bgcolor = ' $Header ::table2colour'>" ;
378 print "<tr bgcolor = ' $Header ::table1colour'>" ;
380 my $settime = read_timefile
( " $set / $datefile " , " $set / $datafile " );
381 my $name = substr ( $set , length ( $setdir )+ 1 );
387 <td align = 'center'>
388 <form method = 'post'>
389 <input type = 'hidden' name = 'ACTION' value =' $Lang ::tr{'restore'}' />
390 <input type = 'image' name = ' $Lang ::tr{'restore'}' src = '/images/reload.gif' alt = ' $Lang ::tr{'restore'}' title = ' $Lang ::tr{'restore'}' />
391 <input type = 'hidden' name = 'KEY' value = ' $set ' />
395 <td align = 'center'>
396 <a href = '/backup/ $name / $datafile '><img src = '/images/floppy.gif' title = ' $Lang ::tr{'export'}'></a>
399 <td align = 'center'>
400 <form method = 'post'>
401 <input type = 'hidden' name = 'ACTION' value = ' $Lang ::tr{'remove'}' />
402 <input type = 'image' name = ' $Lang ::tr{'remove'}' src = '/images/delete.gif' alt = ' $Lang ::tr{'remove'}' title = ' $Lang ::tr{'remove'}' border = '0' />
403 <input type = 'hidden' name = 'KEY' value = ' $set ' />
411 print "</table>" . ( $i ?
"<br>" : " $Lang ::tr{'empty'}!<hr /><br>" );
414 <form method = 'post'>
415 <li> $Lang ::tr{'backup configuration'}<br>
416 $Lang ::tr{'description'}:<input type = 'text' name = 'COMMENT' size='30' />
417 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'create'}' />
419 <form method = 'post' enctype = 'multipart/form-data'>
420 <li> $Lang ::tr{'backup import dat file'}:<br>
421 <input type = 'file' name = 'FH' size = '20' />
422 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'import'}' />
428 print "</td><td></td><td valign='top'>" ; # Start right part (devices selection)
429 print $Lang :: tr
{ 'backup media info' };
431 print "<form method = 'post'>" ;
432 print "<table width = '100%'><tr><td>" ;
433 my $nodev = 1 ; # nothing present
434 foreach my $media ( keys %medias ) {
435 if ( $medias { $media }{ 'Attached' } eq 'Yes' ) { # device is attached to USB bus ?
436 $nodev = 0 ; # at least one device present
437 my $checked = $medias { $media }{ 'Host' } eq $mounted ?
"checked='checked'" : '' ;
438 print "<input type='radio' name = 'SELECT' value = ' $medias { $media }{'Host'}' $checked />" ;
439 print "<b> $medias { $media }{'Product'}</b><br>" ;
440 # list attached partitions to this media
441 foreach my $part ( sort ( keys ( %partitions ))) {
442 if ( $part =~ /$medias{$media}{'Host'}./ ) {
443 my $checked = $part eq $mounted ?
"checked='checked'" : '' ;
444 print " <input type='radio' name = 'SELECT' value = ' $part ' $checked /> $part ( $partitions { $part })<br>" ;
450 print "<br> $Lang ::tr{'insert removable device'}" ;
452 print "<br><input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'done'}' />" ;
454 #Add an entry for the local disk
455 my $checked = $Lang :: tr
{ 'local hard disk' } eq $mounted ?
"checked='checked'" : '' ;
456 print "<input type = 'radio' name = 'SELECT' value = ' $Lang ::tr{'local hard disk'}' $checked />" ;
457 print "<b> $Lang ::tr{'local hard disk'}</b>" ;
459 print "<br><input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'mount'}' />" ;
461 print "</tr></table>" ;
469 <b> $Lang ::tr{'backup key'}</b><br>
470 $Lang ::tr{'backup key info'}<br>
472 <td align= 'right'> $Lang ::tr{'root user password'}:
473 <td align='left'><input type = 'password' name='PASSWORD' />
474 <input type = 'submit' name = 'ACTION' value = ' $Lang ::tr{'backup export key'}' />
476 <td align='right'> $Lang ::tr{'backup protect key password'}:
477 <td align='left'><input type = 'password' name='PASSWORD1' size='10' />
479 <td align='right'> $Lang ::tr{'again'}
480 <td align='left'><input type = 'password' name='PASSWORD2' size='10'/>
487 print "</td></tr></table>" ;
492 & Header
:: closebigbox
();
493 & Header
:: closepage
();
498 <form method = 'post'>
502 <b> $Lang ::tr{'backup to floppy'}</b>
507 $Lang ::tr{'insert floppy'}
510 <input type='submit' name='ACTION' value=' $Lang ::tr{'backup to floppy'}' />
517 print "<b> $Lang ::tr{'alt information'}</b><pre>" .
518 `/usr/local/bin/ipcopbackup -savecfg floppy` .
519 ' </pre>' if ( $settings { 'ACTION' } eq $Lang :: tr
{ 'backup to floppy' } );
522 # Return device name of what is mounted under 'backup'
524 my $mounted = `mount|grep ' /home/httpd/html/backup '` ;
525 if ( $mounted ) { # extract device name
526 $mounted =~ m!^/dev/(.*) on! ; # device on mountmoint options
528 } else { # it's the normal subdir
529 return $Lang :: tr
{ 'local hard disk' };
532 # read and return a date/time string from a time file
533 sub read_timefile
() {
534 my $fname = shift ; # name of file to read from
535 my $fname2 = shift ; # if first file doesn't exist, get date of this file
538 if ( defined ( open ( FH
, "< $fname " ))) {
543 $dt = & get_fdate
( $fname2 ); # get file date/time
544 write_timefile
( $fname , $dt ); # write to expected time file
548 # write a date/time string to a time file
549 sub write_timefile
() {
550 my $fname = shift ; # name of file to write to
551 my $dt = shift ; # date/time string to write
553 if ( open ( FH
, "> $fname " )) {
558 # move a dat file without time stamp to subdir
560 my $dt = get_fdate
( " $setdir / $datafile " ) . shift ;
561 & write_timefile
( " $setdir / $datefile " , $dt );
563 # create set directory
564 my $setname = " $setdir /" . get_ddate
( " $setdir / $datafile " );
567 # move files to the new set directory
568 copy_files
( $setdir , $setname );
569 erase_files
( $setdir );
572 # get date/time string from file
575 open ( DT
, "/bin/date -r $fname |" );
579 $dt =~ s/\s+/ /g ; # remove duplicate spaces
582 # get date/time string from file for use as directory name
585 open ( DT
, "/bin/date -r $fname + %Y %m %d_ %H %M %S |" );
591 # copy archive files from source directory to destination directory
594 my $dest_dir = shift ;
595 map ( copy
( " $src_dir / $_ " , " $dest_dir / $_ " ), ( $datafile , $datefile ) );
600 map ( unlink ( " $src_dir / $_ " ), ( $datafile , $datefile ));
602 # get backup error text
604 my $exit_code = shift || return '' ;
605 if ( $exit_code == 0 ) {
607 } elsif ( $exit_code == 2 ) {
608 return $Lang :: tr
{ 'err bk 2 key' };
609 } elsif ( $exit_code == 3 ) {
610 return $Lang :: tr
{ 'err bk 3 tar' };
611 } elsif ( $exit_code == 4 ) {
612 return $Lang :: tr
{ 'err bk 4 gz' };
613 } elsif ( $exit_code == 5 ) {
614 return $Lang :: tr
{ 'err bk 5 encrypt' };
616 return $Lang :: tr
{ 'err bk 1' };
619 # show any restore errors
622 my $exit_code = shift || return '' ;
623 if ( $exit_code == 0 ) {
625 } elsif ( $exit_code == 6 ) {
626 return $Lang :: tr
{ 'err rs 6 decrypt' };
627 } elsif ( $exit_code == 7 ) {
628 return $Lang :: tr
{ 'err rs 7 untartst' };
629 } elsif ( $exit_code == 8 ) {
630 return $Lang :: tr
{ 'err rs 8 untar' };
631 } elsif ( $exit_code == 9 ) {
632 return $Lang :: tr
{ 'missing dat' };
634 return $Lang :: tr
{ 'err rs 1' }. "( $exit_code )" ;
638 my ( $value , $length , $opt_U ) = @_ ;
639 if ( $value > 10 **( $length + 8 ) or $opt_U eq 'T' ) {
640 return sprintf ( " %d %s " , int ( ( $value / 1024 ** 4 ) + .5 ), 'T' );
641 } elsif ( $value > 10 **( $length + 5 ) or $opt_U eq 'G' ) {
642 return sprintf ( " %d %s " , int ( ( $value / 1024 ** 3 ) + .5 ), 'G' );
643 } elsif ( $value > 10 **( $length + 2 ) or $opt_U eq 'M' ) {
644 return sprintf ( " %d %s " , int ( ( $value / 1024 ** 2 ) + .5 ), 'M' );
645 } elsif ( $value > 10 **( $length ) or $opt_U eq 'K' ) {
646 return sprintf ( " %d %s " , int ( ( $value / 1024 ) + .5 ), 'K' );