xrs.in

一套客户/服务器模式的备份系统代码,跨平台,支持linux,AIX, IRIX, FreeBSD, Digital Unix (OSF1), Solaris and HP-UX.

#!/usr/bin/wish
################### Start of $RCSfile: xrs.in,v $ ##################
#
# $Source: /home/alb/afbackup/afbackup-3.3.8.1/RCS/xrs.in,v $
# $Id: xrs.in,v 1.3 2004/07/08 20:34:42 alb Exp alb $
# $Date: 2004/07/08 20:34:42 $
# $Author: alb $
#
#
####### description ################################################
#
#
#
####################################################################

set prefix "@prefix@"
set TEXTDOMAIN "@PACKAGE@"
set TEXTDOMAINDIR "@commondatadir@/locale"

proc T_ { text } {
  global TEXTDOMAIN TEXTDOMAINDIR

  return [ INTL_gettext $text $TEXTDOMAIN $TEXTDOMAINDIR ]
}

proc TN_ { text } {
  return $text
}

# user settable section

set BACKUP_HOME_DEFAULT $env(BACKUP_HOME_DEFAULT)
set BINDIR "@clientbindir@"

set poss_binsubs { bin sbin "" }

if { [ info exists env(BACKUP_HOME) ] } {
  set BACKUP_HOME $env(BACKUP_HOME)

  foreach binsub $poss_binsubs {
    if { [ file executable "$BACKUP_HOME/$binsub/afrestore"
      set BINDIR "$BACKUP_HOME/$binsub"
    }
  }
}
set found 0
set configfiles "$BACKUP_HOME_DEFAULT/lib/backup.conf /etc/buclient.conf /etc/afbuclient.conf /etc/afclient.conf /etc/afbackup/client.conf"
lappend configfiles "@clientconfdir@/@clientconf@" "@clientlibdir@/@clientconf@"
foreach configfile "$configfiles" {
  if { [ file readable $configfile ] } {
    set found 1
    break
  }
}

set CMDPREFIX "||| "
set cmdprefixlast [ expr [ string length $CMDPREFIX ] - 1 ]

set restoreprog "$BINDIR/afrestore"
set packprog "$BINDIR/__packpats"

source "@commonshlibdir@/aftcllib.tcl"

if { ! [ file executable $packprog ] } {
  puts stderr [ format [ T_ "Error: Program %s not executable. Exiting." ] $packprog ]
  exit 1
}

if { ! $found } {
  puts stderr [ T_ "Error: Cannot read configuration file. Exiting." ]
  exit 2
}
set num_fix_params	21
set num_var_sp_idx	21

set var_param_idx [ expr $num_fix_params + 2 ]
set fix_param_idx [ expr $num_fix_params + 1 ]

set patterns(1) {[Bb]ackup[ \t_-]*[Hh]ost:?}
set patterns(2) {[Bb]ackup[ \t_-]*[Pp]ort:?}
set patterns(3) {[Cc]artr?i?d?g?e?[-_ \t]*[Ss]et:?}
set patterns(4) {[Cc]ompress[-_ \t]*[Cc]o?m?ma?n?d:?}
set patterns(5) {[Uu]ncompress[-_ \t]*[Cc]o?m?ma?n?d:?}
set patterns(6) {[Ii]ndex[ \t_-]*[Ff]ile[ \t_-]*[Pp]art:?}
set patterns(7) {[Cc]ompress[-_ \t]*[Bb]ackupe?d?[-_ \t]*([Ff]iles)?:?}
set patterns(8) {[Cc]ompress[-_ \t]*[Ll]ogg?i?n?g?[-_ \t]*[Ff]iles:?}
set patterns(9) {[Dd]o[-_ \t]*[Nn][\'o]?t[-_ \t]*[Cc]ompress:?}
set patterns(10) {[Nn]um[-_ \t]*[Ii]nd(ic|ex)es[-_ \t]*[Tt]o[ \t_-]*[Ss]tore:?}
set patterns(11) {[Ll]ogg?i?n?g?[-_ \t]*[Ff]ile:?}
set patterns(12) {[Vv][Aa][Rr][-_ \t]*[Dd]ire?c?t?o?r?y?:?}
set patterns(13) {([Ee]n)?[Cc]rypti?o?n?[ \t_-]*[Kk]ey[ \t_-]*[Ff]ile:?}
set patterns(14) {[Ss]tartu?p?[-_ \t]*[Ii]nfo[-_ \t]*[Pp]rogram:?}
set patterns(15) {[Ii]nit[-_ \t]*[Pp]rogram:?}
set patterns(16) {[Ee]xit[-_ \t]*[Pp]rogram:?}
set patterns(17) {[Rr]oot[ \t_-]*[Dd]ire?c?t?o?r?y?:?}
set patterns(18) {[Ff]iles[ \t_-]*[Tt]o[ \t_-]*[Ss]kip:?}
set patterns(19) {[Dd]ire?c?t?o?r?i?e?s[ \t_-]*[Tt]o[ \t_-]*[Ss]kip:?}
set patterns(20) {[Ee]xclu?d?e?[-_ \t]*[Ll]ist[-_ \t]*[Ff]ile[-_ \t]*[Nn]?a?m?e?:?}
set patterns(21) {[Nn]um[-_ \t]*[Bb]ackup[-_ \t]*[Pp]arts:?}
set patterns(22) {[Dd]ire?c?t?o?r?i?e?s[ \t_-]*[Tt]o[ \t_-]*[Bb]ackup:?}
set patterns(23) {[Dd]ire?c?t?o?r?i?e?s[ \t_-]*[Tt]o[ \t_-]*[Bb]ackup[ \t]*#num#[ \t]*:?}

set varnames { i backuphosts backupports cartridgesets compresscmd
		uncompresscmd indexfilepart compressdata compressindex
		dontcompress numindexes logfile vardir encrkeyfile
		startinfoprog initprog exitprog rootdir filestoskip
		dirstoskip excludelistfile numparts dirstobackup dirstobackup }

for { set i 1 } { $i <= $var_param_idx } { incr i } {
  set types($i) s
}
set types(7) b
set types(8) b

# end of user settable section

set var_param_idx [ expr $num_fix_params + 2 ]
set fix_param_idx [ expr $num_fix_params + 1 ]


proc getparam { pat } {
  global configfile

  set pattern {^[ \t]*}
  append pattern $pat
  append pattern {[ \t]*}


  set errfl [ catch { set fp [ open $configfile r ] } ]
  if { $errfl } {
    puts stderr [ format [ T_ "Error: Cannot open file `%s'" ] $configfile ]

    exit 0
  }

  while { [ gets $fp line ] >= 0 } {
    if { [ regexp -indices $pattern $line i1 ] } {
      close $fp
      set idx [ expr [ lindex $i1 1 ] + 1 ]
      return [ string trim [ string range $line $idx end ] ]
    }
  }

  close $fp
  return ""
}

set varnames [ GStr_replSubstring $varnames "\n" " " ]

for { set i 1 } { $i <= $num_fix_params } { incr i } {
  set values($i) [ getparam $patterns($i) ]
  set [ lindex $varnames $i ] $values($i)
}
if { $num_var_sp_idx > 0 } {
  set num_var_params $values($num_var_sp_idx)
} else {
  set num_var_params 0
}
if { $num_var_params > 0 } {
  if { $num_var_params > 1 } {
    for { set i 0 } { $i < $num_var_params } { incr i } {
      set l [ expr $num_fix_params + $i + 1 ]
      set j [ expr $i + 1 ]
      set pattern [ GStr_replSubstring $patterns($var_param_idx) {#num#} $j ]
      set values($l) [ getparam $pattern ]
      set vnam [ lindex $varnames $var_param_idx ]
      append vnam "($j)"
      set $vnam $values($l)
    }
  } else {
    set values($fix_param_idx) [ getparam $patterns($fix_param_idx) ]
    set [ lindex $varnames $fix_param_idx ] $values($fix_param_idx)
  }
}

if { $vardir == "" } {
  unset vardir
}

if { ! [ info exists vardir ] } {
  set vardir "@clientvardir@"
  if { [ info exists BACKUP_HOME ] } {
    set vardir "$BACKUP_HOME/var"
  }
}

set numfile "$vardir/num"

set errfl [ catch { set fp [ open $numfile r ] } ]
if { $errfl } {
  puts stderr [ format [ T_ "Error: Cannot read current backup number file %s." ] $numfile ]
  exit 1
}

gets $fp bunum
close $fp

set indexfiles ""

while { 1 } {
  set r [ file readable "$indexfilepart$bunum" ]
  set rz [ file readable "$indexfilepart$bunum.z" ]

  if { ! $r && ! $rz } {
    break
  }

  if { $r } {
    set indexfiles [ linsert $indexfiles 0 "$indexfilepart$bunum" ]
  }
  if { $rz } {
    set indexfiles [ linsert $indexfiles 0 "$indexfilepart$bunum.z" ]
  }

  incr bunum -1
}

proc show_details { widget } {
  global	ignore_case restoretapes restoreprog detailfmt pathentry

  set filterargs ""

  set allnsel [ $widget curselection ]

  if { [ llength $allnsel ] == 0 } {
    GGUI_errorDialog [ T_ "Nothing has been selected." ]

    return
  }

  foreach nsel $allnsel {
    set sel [ $widget get $nsel ]

    if { $sel == ".." || $sel == "" || $sel == "." } {
      continue
    }

    set dirsep [ string first "/" $sel ]
    set pathlen [ string length $pathentry ]
    incr pathlen -1
    if { [ string index $pathentry $pathlen ] == "/" || $pathentry == "" } {
      set newentry "$pathentry$sel"
    } else {
      set newentry "$pathentry/$sel"
    }

    set newentry [ GStr_replSubstring $newentry "\\" "\\\\" ]

    append filterargs " -p '$newentry'"
  }

  set restoreopt [ restore_date_opt shell ]

  if { $ignore_case } {
    set restoreopt "$restoreopt -i"
  }

  set cmd {/bin/sh -c "}
  append cmd "$restoreprog -l -F '$detailfmt' $filterargs $restoreopt" {"}

  GGUI_runCommand [ T_ "Details" ] $cmd
}

proc run_list_program { pathfilter matches } {
  upvar $matches lines
  global	uncompresscmd restoreprog packprog ignore_case restoretapes
  global	cmdprefixlast CMDPREFIX

  set restoreopt [ restore_date_opt shell ]

  if { $ignore_case } {
    set restoreopt "$restoreopt -i"
  }

  if { [ llength [ string trim $restoretapes ] ] > 0 } {
    set restoreopt "$restoreopt -T '$restoretapes'"
  }

  set pathfilter1 [ GStr_replSubstring $pathfilter "\\" "\\\\" ]

  set cmd {| /bin/sh -c "echo y | }
  append cmd "$restoreprog -qL $restoreopt -p '$pathfilter1*' 2>/dev/null | $packprog '$pathfilter1'"
  append cmd {"}

  set errfl [ catch { set fp [ open $cmd r ] } ]
  if { $errfl } {
    return ""
  }

  if { $pathfilter != "/" && $pathfilter != "" } { 
    append pathfilter "/"
  }
  set plen [ string length $pathfilter ]
  incr plen -1

  set subentmsg [ T_ "Found subentry" ]

  while { [ gets $fp new_line ] >= 0 } {
    set nline [ string trim $new_line ]
    if { $nline == "" || [ string index $nline 0 ] == "#" } {
      continue
    }

    if { [ string range $nline 0 $cmdprefixlast ] == $CMDPREFIX } {
      if { [ lsearch -exact $lines $nline ] < 0 } {
        lappend lines $nline
      }
      continue
    }

    set path [ string range $new_line 0 $plen ]
#    if { "$path" == "$pathfilter" } {
#      set name [ file tail $path ]
#      if { [ lsearch -exact $lines $name ] < 0 } {
#	 lappend lines $name
#      }
#    } else 
    if { "$path" == "$pathfilter" } {
      set name [ string range $new_line [ expr $plen + 1 ] end ]
      set i [ string first "/" $name ]
      if { $i == 0 && $path == "" } {
	continue
      }
      set ispath [ expr $i >= 0 ? 1 : 0 ]
      if { $ispath } {
	incr i -1
	set name [ string range $name 0 $i ]
      }
      set notempty [ string length $name ]
      set exists_exact [ lsearch -exact $lines $name ]
      set exists_dir [ lsearch -exact $lines "$name/" ]
      if { $ispath } {
	append name "/"
      }
      if { $notempty && $exists_exact < 0 && $exists_dir < 0 } {
	lappend lines $name

	show_status "$subentmsg: $name ..."
      }
      if { $exists_exact >= 0 && $ispath } {
	set lines [ lreplace $lines $exists_exact $exists_exact $name ]

	show_status "$subentmsg: $name ..."
      }
    }
  }

  close $fp

  return $lines
}

proc filter_indexfiles { pathpattern } {
  global	indexfiles dirscache

  if { [ info exists dirscache($pathpattern) ] } {
    return $dirscache($pathpattern)
  }
  
  show_status [ T_ "Scanning index ..." ]

  set matches ""

  run_list_program $pathpattern matches

  set dirscache($pathpattern) [ lsort $matches ]

  show_status [ T_ "Done scanning index." ]

  return $dirscache($pathpattern)
}

proc show_win { } {
  global	num_fix_params values prompts num_var_sp_idx
  global	var_param_idx fix_param_idx types num_var_params
  global	textwidth entrywidth varnames statuswidget
  global	selected_dirs initlist

  eval global $varnames

  frame .top
  
  frame .top.mbar -relief raised -bd 2
  frame .top.dirs -borderwidth 2 -relief sunken
  frame .top.sel -borderwidth 2 -relief sunken
  frame .top.opts -borderwidth 2 -relief sunken
  frame .top.cmds -borderwidth 2 -relief sunken

  frame .top.dirs.path
  frame .top.dirs.subdirs
  frame .top.stat
  
  menubutton .top.mbar.help -text [ T_ "Help" ] -underline 0 -menu .top.mbar.help.menu
  menu .top.mbar.help.menu
  .top.mbar.help.menu add command -label [ T_ "What now ?" ] -command what_now -underline 0

  label .top.dirs.path.label -text [ T_ "Path:" ] -anchor w
  entry .top.dirs.path.entry -textvariable pathentry -width $entrywidth
  
  label .top.dirs.subdirs.label -text [ T_ "Subentries:" ] -anchor w
  frame .top.dirs.subdirs.list
  listbox .top.dirs.subdirs.list.listbox -selectmode extended -yscrollcommand ".top.dirs.subdirs.list.scrollbar set"
  scrollbar .top.dirs.subdirs.list.scrollbar -command ".top.dirs.subdirs.list.listbox yview"
  
  frame .top.sel.frame1
  button .top.sel.frame1.button1 -text [ format "v %s v" [ T_ "Select" ] ] -command { select_callback .top.dirs.subdirs.list.listbox }
  button .top.sel.frame1.button2 -text [ T_ "Show Details" ] -command { show_details .top.dirs.subdirs.list.listbox }
  frame .top.sel.list
  button .top.sel.button2 -text [ T_ "Delete" ] -command { deselect_callback .top.sel.list.listbox }
  listbox .top.sel.list.listbox -selectmode extended -yscrollcommand ".top.sel.list.scrollbar set"
  scrollbar .top.sel.list.scrollbar -command ".top.sel.list.listbox yview"

  button .top.opts.button -text [ T_ "Options ..." ] -command { GGUI_basicDialog [ T_ "Restore Options" ] show_options_dialog }

  button .top.cmds.go -text [ T_ "Start Restore" ] -command "do_restore .top.sel.list.listbox"
  button .top.cmds.exit -text [ T_ "Exit" ] -command "exit 0"

  label .top.stat.label
  set statuswidget .top.stat.label
  $statuswidget configure -text [ T_ "Ready for operation." ]

  pack .top.mbar.help -fill x -side right

  pack .top.sel.list.listbox .top.sel.list.scrollbar -side left -fill both
  pack .top.sel.list.listbox -expand 1
  pack .top.sel.frame1.button1 -expand 1 -side left
  pack .top.sel.frame1.button2 -expand 1 -anchor e -after .top.sel.frame1.button1
  pack .top.sel.frame1 -expand 1 -fill x
  pack .top.sel.list -side top -fill both -expand 1
  pack .top.sel.button2 -side top -pady 2

  pack .top.dirs.subdirs.list.listbox .top.dirs.subdirs.list.scrollbar -side left -fill both
  pack .top.dirs.subdirs.list.listbox -expand 1
  pack .top.dirs.subdirs.label .top.dirs.subdirs.list -side top -fill x
  pack .top.dirs.subdirs.list -fill both -expand 1
  
  pack .top.dirs.path.label .top.dirs.path.entry -side left -fill both
  pack .top.dirs.path.entry -expand 1
  
  pack .top.dirs.path .top.dirs.subdirs -side top -fill x
  pack .top.dirs.subdirs -fill both -expand 1
  
  pack .top.opts.button -pady 2

  pack $statuswidget -fill x

  pack .top.cmds.go .top.cmds.exit -pady 2 -side left -expand 1

  pack .top.mbar .top.dirs .top.sel .top.opts .top.cmds .top.stat -side top -fill x -pady 2 -padx 2
  pack .top.sel -fill both -expand 1
  pack .top.dirs -fill both -expand 1
  pack .top.cmds -fill both -expand 1

  pack .top -fill both -expand 1

  bind .top.dirs.path.entry <Return> { update_list .top.dirs.subdirs.list.listbox }
  bind .top.dirs.subdirs.list.listbox <ButtonPress-3> { button3_callback .top.dirs.subdirs.list.listbox %x %y }
  bind .top.dirs.subdirs.list.listbox <Double-Button-1> 

  bind .top.dirs.path.entry <F1> help_on_path
  bind .top.dirs.path.entry <F2> help_on_path
  bind .top.dirs.path.entry <Escape> help_on_path
  bind .top.dirs.subdirs.list.listbox <F1> help_on_subentries
  bind .top.dirs.subdirs.list.listbox <F2> help_on_subentries
  bind .top.dirs.subdirs.list.listbox <Escape> help_on_subentries
  bind .top.sel.list.listbox <F1> help_on_selected
  bind .top.sel.list.listbox <F2> help_on_selected
  bind .top.sel.list.listbox <Escape> help_on_selected

  set_list .top.dirs.subdirs.list.listbox $initlist

  wm title . [ T_ "AF's Restore Utility" ]
}

proc show_options_dialog { parent tkpvar } {
  global	tkPriv relocdir dirscache
  global	hour_a min_a day_a month_a year_a
  global	hour_b min_b day_b month_b year_b

  set p $parent