#!/usr/bin/perl -w
#########################################################################
# Система создания, хранения, и обновления резервных копий файлов	#
#									#
#				 (c) Sergey Babitch <vinny@babitch.com>	#
#########################################################################

$SIG { HUP  } = sub { $Stop = 1 };
$SIG { INT  } = sub { $Stop = 1 };
$SIG { QUIT } = sub { $Stop = 1 };
$SIG { TERM } = sub { $Stop = 1 };
$SIG { USR1 } = sub { $Stop = 1 };
$SIG { USR2 } = sub { $Stop = 1 };

exit 1 unless startup (); unlink $spool . ".process";
exit 1 unless backup  (); unlink $spool . ".process";

#========================================================================
# Парсер конфига и главный диспетчер программы
#========================================================================
sub backup {
  local *C;
  unless ( open C, "<$config" ) {
    printf "Не удается открыть файл конфигурации для чтения:\n";
    printf "Файл:    \"%s\"\n", $config;
    printf "Причина: \"%s\"\n", $!;
    return 0;
  }
  while (<C>) {
    my $string	= $_; chomp ($string);
    my $line	= $.;
    s/^([^#]*(\\#[^#]*)*(\\#|[^#\\])|)#.*$/$1/;
    next if /^\s*$/;
    s/^(.*\S)\s*$/$1/;
    s/^\s*(\S.*)$/$1/;
    if ( /^(\S+)\s*:\s*(\S.*)$/ ) {
      my $key	= $1;
      my $value	= $2;
      if ( $key =~ /^file$/i ) {
        next if backup_file ($value);
      }
      elsif ( $key =~ /^tree$/i ) {
        next if backup_tree ($value);
      }
      elsif ( $key =~ /^secure$/i ) {
        next if backup_filter ($diff_filters, $value);
      }
      elsif ( $key =~ /^save$/i ) {
        next if backup_filter ($copy_filters, $value);
      }
      elsif ( $key =~ /^mask$/i ) {
        next if backup_filter ($file_filters, $value);
      }
      else {
        printf "Неизвестный ключ \"%s\" в файле конфигурации:\n",
	                                    string_shield ($key);
      }
    }
    else {
      print "Синтаксическая ошибка в файле конфигурации:\n";
    }
    printf "  Файл конфигурации: \"%s\"\n", $config;
    printf "  Номер строки:      %d\n"  , $line;
    printf "  Строка:            \"%s\"\n", string_shield ($string);
  }
  close C;
  return 1;
}
#========================================================================
# Сохранение резервной копии файла
#========================================================================
sub backup_file {
  my $s = shift;
  unless (defined $s ) {
    print "Не определено значение ключа конфигурации \"file\"\n";
    return 0;
  }
  my ( $name, $secure, $filter, @tail ) = parse_arguments_string ($s);
  unless ( defined $name ) {
    print "Не определено значение ключа конфигурации \"file\"\n";
    return 0;
  }
  unless ( $name =~ /^\// ) {
    print "В имени файла должен быть указан полный путь ...\n";
    return 0;
  }
  unless ( -f $name ) {
    print "Отсутствует файл \"$name\" ...\n";
    return 0;
  }
  unless ( -r $name ) {
    print "Файл \"$name\" не доступен для чтения ...\n";
    return 0;
  }
  if ( $filter ) {
    unless ( exists $copy_filters -> { $filter } ) {
      print "Фильтр копирования файла \"$filter\" не определен ...\n";
      return 0;
    }
    $filter = $copy_filters -> { $filter } ;
  }
  elsif ( exists $copy_filters -> { $name } ) {
    $filter    = $copy_filters -> { $name } ;
  }
  else {
    $filter = undef;
  }
  if ( $secure ) {
    unless ( exists $diff_filters -> { $secure } ) {
      print "Фильтр безопасности \"$secure\" не определен ...\n";
      return 0;
    }
    $secure = $diff_filters -> { $secure } ;
  }
  elsif ( exists $diff_filters -> { $name } ) {
    $secure    = $diff_filters -> { $name } ;
  }
  else {
    $secure = undef;
  }
  system " echo $name >> " . $spool . ".process";
  return 0 unless copy_file   ( $name, ( $spool . $name ), $filter );
  return 0 unless commit_file (        ( $spool . $name ), $secure );
  return 1;
}
#========================================================================
# Парсер конфигурации строки фильтра
#========================================================================
sub backup_filter {
  my $filters = shift;
  unless ( $filters ) {
    print "Не указан хэш фильтров при вызове функции \"backup_filter\" ...\n";
    return 0;
  }
  my $string = shift;
  unless ( $string ) {
    print "Не указан фильтр при вызове функции \"backup_filter\" ...\n";
    return 0;
  }
  my ( $name, $cmd, $template, @tail ) = parse_arguments_string ( $string );
  unless ( $name ) {
    print "Ошибка в фильтре при вызове функции \"backup_filter\" ...\n";
    return 0;
  }
  if ( @tail ) {
    print "Лишние аргументы фильтра при вызове функции \"backup_filter\" ...\n";
    return 0;
  }
  if ( $cmd =~ /^(=|alias)$/i ) {
    if ( exists $filters -> { $name } and exists $filters -> { $template } ) {
      print "Фильтры \"$name\" и \"$template\" не могут\n";
      print "быть синонимами, т.к. они оба были определены ранее ...\n";
      return 0;
    }
    my $filter;
    $filter = $filters->{$name}     if exists  $filters->{$name}	;
    $filter = $filters->{$template} if exists  $filters->{$template}	;
    $filter = [ $filter_all ]   unless defined $filter			;
    $filters->{$name}			     = $filter			;
    $filters->{$template}		     = $filter			;
    return 1;
  }
  unless ( exists $filters -> { $name } ) {
                  $filters -> { $name } = [ $filter_all ];
  }
  if ( $cmd =~ /^(add)$/i ) {
    unless ( exists $filters -> { $template } ) {
      print "Фильтр безопасности \"$template\" не определен ...\n";
      return 0;
    }
    pop  @{ $filters -> { $name } }					;
    push @{ $filters -> { $name } }, @{ $filters -> { $template } }	;
    return 1;
  }
  my $filter;
  $filter -> [0] = $plus    if $cmd =~ /^(\+|ACCEPT)$/i;
  $filter -> [0] = $minus   if $cmd =~ /^(\-|DROP|REJECT)$/i;
  $filter -> [0] = $command if $cmd =~ /^(c|cmd|command)$/i;
  unless ( defined $filter -> [0] ) {
    print "Неизвестная команда \"$cmd\" в описании фильтра ...\n";
    return 0;
  }
  $filter -> [1] = string_unshield ( $template );
  pop  @{ $filters -> { $name } }		;
  push @{ $filters -> { $name } }, $filter	;
  push @{ $filters -> { $name } }, $filter_all	;
  return 1;
}
#========================================================================
# Сохранение резервной копии дерева каталогов
#========================================================================
sub backup_tree {
  local *P;
  my $s = shift;
  unless (defined $s ) {
    print "Не определено значение ключа конфигурации \"tree\"\n";
    return 0;
  }
  my ( $path, $mask, $secure, $filter, @tail ) = parse_arguments_string ($s);
  unless ( $path ) {
    print "Не определено значение ключа конфигурации \"tree\"\n";
    return 0;
  }
  unless ( $path =~ /^\// ) {
    print "Необходимо указывать полный путь к дереву каталогов ...\n";
    return 0;
  }
  unless ( -d $path ) {
    print "Отсутствует каталог \"$path\" ...\n";
    return 0;
  }
  if ( @tail ) {
    print "Лишние аргументы ключа конфигурации \"tree\" ...\n";
    return 0;
  }
  unless ( -r $path ) {
    print "Каталог \"$path\" не доступен для чтения ...\n";
    return 0;
  }
  $filter = "" unless $filter;
  $secure = "" unless $secure;
  if ( $mask ) {
    unless ( exists $file_filters -> { $mask } ) {
      print "Фильтр отбора файлов \"$mask\" не определен ...\n";
      return 0;
    }
    $mask = $file_filters -> { $mask } ;
  }
  elsif ( exists $file_filters -> { $path } ) {
    $mask      = $file_filters -> { $path } ;
  }
  else {
    $mask = undef;
  }
  open P, " $find $path | ";
  my @files = <P>;
  close P;
  if ($?) {
    print "Не удается получить список файлов дерева каталогов ...\n";
    return 0;
  }
  foreach my $file ( @files ) {
    last if $Stop;
    chomp ($file);
    next if -d $file;
    next if -l $file;
    if ( $mask ) {
      foreach my $mask ( @{$mask} ) {
        $_ = $file;
        if ( $mask->[0] == $command ) {
          eval $mask->[1];
	  if ( $@ ) {
	    my $error  = $@; chomp ($error);
	    my $string = $_; chomp ($string);
	    printf "Ошибка при выполнении команды фильтрации имен файлов:\n";
	    printf "  Имя файла:         \"%s\"\n", string_shield ( $string    );
	    printf "  Команда:           \"%s\"\n", string_shield ( $mask->[1] );
	    printf "  Ошибка:            \"%s\"\n", string_shield ( $error     );
	    return 0;
	  }
          $file = $_;
        }
	elsif ( /$mask->[1]/ ) {
	  if ( $mask->[0] == $plus ) {
            backup_file ( "\"$file\", \"$secure\", \"$filter\"" );
	  }
	  last;
	}
      }
    }
    else {
      backup_file ( "\"$file\", \"$secure\", \"$filter\"" );
    }
  }
  return 1;
}
#========================================================================
# Проверка доступности файла
#========================================================================
sub check_access {
  my $name = shift;
  return 0 unless defined $name;
  unless ( -f $name ) {
    print "Не найден файл \"$name\"...\n";
    return 0;
  }
  unless ( -r $name ) {
    print "Нет прав на чтение файла \"$name\"...\n";
    return 0;
  }
  return 1;
}
#========================================================================
# Проверка готовности каталога для работы с cvs
#========================================================================
sub check_cvsable {
  local *P;
  my $name	= shift;
  my $quiet	= shift;
  return 0 unless defined $name;
  return 0 unless check_dir ($name);
  if ( open P, "cd $name; $cvs -f update not-exist-test-file 2>&1 |" ) {
    while (<P>) {
      if ( /cvs server: nothing known about not-exist-test-file/ ) {
        close P;
	return 1;
      }
      print unless $quiet;
    }
    close P;
  }
  unless ( $quiet ) {
    print "Каталог \"$name\" не подготовлен для работы с cvs ...\n";
  }
  return 0;
}
#========================================================================
# Проверка доступности каталога
#========================================================================
sub check_dir {
  my $name = shift;
  return 0 unless defined $name;
  if ( -f $name ) {
    print "Файл \"$name\" не является каталогом...\n";
    return 0;
  }
  unless ( -d $name ) {
    print "Не найден каталог \"$name\"...\n";
    return 0;
  }
  return 1;
}
#========================================================================
# Проверка доступности и выполнимости исполняемого файла
#========================================================================
sub check_executable {
  my $name = shift;
  return 0 unless defined $name;
  return 0 unless check_access ($name);
  unless ( -x $name ) {
    print "Нет прав на выполнение файла \"$name\"...\n";
    return 0;
  }
  return 1;
}
#========================================================================
# Сохранение резервной копии файла в cvs репозиторий
#========================================================================
sub commit_file {
  local *P;
  my $name		= shift;
  my $secure		= shift;
  my $make_cvsable	= shift;
  return 0 unless defined $name;
  return 0 unless $name =~ /^(.*)\/([^\/]+)$/;
  my $path = $1;
  $name = $2;
  $make_cvsable = "" unless defined $make_cvsable;
  $rename =  $name;
  $rename =~ s/\+/\\+/g;;
  if ( open ( P, " cd $path ; $cvs -f diff -u \"$name\" 2>&1 | " ) ) {
    while (<P>) {
      if ( /^cvs diff: No CVSROOT specified!/ ) {
        close P;
        if ( $make_cvsable eq "path" ) {
	  print "Не удается подключить каталог \"$path\" к дереву ";
	  print "рабочих каталогов cvs репозитория ...\n";
	  return 0;
	}
	return 0 unless make_cvsable ( "$path/$name" );
        return commit_file ("$path/$name", $secure, "path");
      }
      if ( /^cvs server: I know nothing about $rename$/ ) {
        close P;
        if ( $make_cvsable eq "name" ) {
	  print "Не удается добавить в cvs репозиторий файл\n";
	  print "   \"$path/$name\" ...\n";
	  return 0;
	}
	if ( open ( P, " cd $path ; $cvs -f add \"$name\" 2>&1 | " ) ) {
	  while (<P>) {
	    if ( /^cvs server: $name added independently by second party$/ ) {
	      close P;
	      system " cd $path ; $cvs -f update \"$name\" ";
	      return commit_file ("$path/$name", $secure, "name");
	    }
	  }
          close P;
	}
        return commit_file ("$path/$name", $secure, "name");
      }
      if ( defined $secure ) {
        foreach my $filter ( @{$secure} ) {
	  if ( $filter->[0] == $command ) {
	    eval $filter->[1];
	    if ( $@ ) {
	      print "Ошибка при выполнении команды фильтрации diff-а:\n";
	      print "   Команда: \"", string_shield ( $filter->[1] ), "\"\n";
	      print "   Ошибка:  \"", string_shield ( $@           ), "\"\n";
	    }
	  }
	  elsif ( /$filter->[1]/ ) {
	    print if $filter->[0] == $plus;
	    last;
	  }
	}
      }
      else {
        print;
      }
    }
  }
  close P;
  open P, " cd $path ; $cvs -f commit -m \"\" \"$name\" |";
  while (<P>) {
    print;
  }
  close P;
  return 1;
}
#========================================================================
# Копирование файла
#========================================================================
sub copy_file {
  local *I;
  local *O;
  my $i		= shift;
  my $o		= shift;
  my $filter	= shift;
  return 0 unless defined $i;
  return 0 unless defined $o;
  return 0 unless      -r $i;
  my $type = qx($file "$i");
  my $f    = $i;
  $f =~ s/\+/\\+/g;
  chomp $type;
# $type =~ s/^[^:]*:\s*(\S.*)$/$1/;
# $type =~ s/^$i:\s*(\S.*)$/$1/;
  $type =~ s/^$f:\s*(\S.*)$/$1/;
  unless (
    $type eq '8086 relocatable (Microsoft)'				or
    $type eq 'ASCII C program text'					or
    $type eq 'ASCII C++ program text'					or
    $type eq 'ASCII English text'					or
    $type eq 'ASCII English text, with very long lines'			or
    $type eq 'ASCII M4 macro language pre-processor text'		or
    $type eq 'ASCII text'						or
    $type eq 'ASCII text, with very long lines'				or
    $type eq 'Assembler source'						or
    $type eq 'Bourne shell script text executable'			or
    $type eq 'Bourne-Again shell script text executable'		or
    $type eq 'empty'							or
    $type eq 'HTML document text'					or
    $type eq 'ISO-8859 C program text'					or
    $type eq 'ISO-8859 C program text, with CRLF line terminators'	or
    $type eq 'ISO-8859 English text'					or
    $type eq 'ISO-8859 mail text'					or
    $type eq 'ISO-8859 text'						or
    $type eq 'magic text file for file(1) cmd'				or
    $type eq 'news or mail text'					or
    $type eq 'perl script text executable'				or
    $type eq 'script text executable for sh'				or
    $type eq 'shell archive or script for antique kernel text'		or
    $type =~ /^a \S+ script text executable$/				or
    $type =~ /^Non-ISO extended-ASCII text/
  ) {
    printf "Неизвестный тип файла, резервное копирование отменено ...\n";
    printf "  Копируемый файл:   \"%s\"\n", $i;
    printf "  Тип:               \"%s\"\n", string_shield ($type);
    return 0;
  }
  make_path ($o);
  return 0 unless open I, "<$i";
  unless ( open O, ">$o" ) {
    close I;
    return 0;
  }
  while (<I>) {
    if ( defined $filter ) {
      foreach my $filter ( @{$filter} ) {
        if ( $filter->[0] == $command ) {
          eval $filter->[1];
	  if ( $@ ) {
	    my $error  = $@; chomp ($error);
	    my $string = $_; chomp ($string);
	    printf "Ошибка при выполнении команды фильтрации копирования файла:\n";
	    printf "  Строка:            \"%s\"\n", string_shield ( $string      );
	    printf "  Команда:           \"%s\"\n", string_shield ( $filter->[1] );
	    printf "  Ошибка:            \"%s\"\n", string_shield ( $error       );
	    return 0;
	  }
        }
	elsif ( /$filter->[1]/ ) {
	  print O if $filter->[0] == $plus;
	  last;
	}
      }
    }
    else {
      print O;
    }
  }
  close O;
  close I;
  my @stat = stat ($i);
  chown ($stat[4], $stat[5], $o);
  chmod (($stat[2] & 07777), $o);
  return 1;
}
#========================================================================
# Формирование полного пути
#========================================================================
sub full_path {
  my $path = shift;
  return "" unless defined $path;
  $path =~ s/^\.\///;
  unless ( $path =~ /^\// ) {
    my $wd = qx($pwd);
    chomp $wd;
    $path = "$wd/$path";
  }
  $path = "$1/$2" while $path =~ /^(.*)\/\.\/(.*)$/;
  $path = "$1/$2" while $path =~ /^(.*)\/\/(.*)$/;
  $path = "$1/$2" while $path =~ /^(.*)\/[^\/]*[^\/\.][^\/]*\/\.\.\/(.*)$/;
  return $path;
}
#========================================================================
# Подключение каталога к дереву рабочих каталогов cvs репозитория
#========================================================================
sub make_cvsable {
  my $path = shift;
  return 0 unless $path =~ /^(.*)\/[^\/]+$/;
  $path = $1;
  return 1 if check_cvsable ($path, 'quiet');
  return 0 unless make_cvsable ($path);
  return 0 unless $path =~ /^(.*)\/([^\/]+)$/;
  system " cd $1 ; $cvs -f add $2";
  return 0 unless check_cvsable ($path);
  return 1;
}
#========================================================================
# Создание дерева каталогов полного имени файла
#========================================================================
sub make_path {
  my $path = shift;
  return 0 unless $path =~ /^(.*)\/[^\/]+$/;
  $path = $1;
  return 1 if -d $path;
  return 0 unless make_path ($path);
  return 0 unless $path =~ /^(.*)\/[^\/]+$/;
  my @stat = stat $1;
  return 0 unless @stat;
  mkdir $path, ($stat[2] & 07777);
  chown $stat[4], $stat[5], $path;
  return 0 unless -d $path;
  return 1;
}
#========================================================================
# Преобразование строки аргументов в массив аргументов
#========================================================================
sub parse_arguments_string {
  my $string	= shift;
  my @arguments	= ();
  $string = "" unless defined $string;
  while ( $string ) {
    my $argument;
    ($argument, $string) = parse_first_argument ($string);
    return () unless defined $argument;
    push @arguments, $argument;
  }
  return @arguments;
}
#========================================================================
# Выделение первого значения строки аргументов
#========================================================================
sub parse_first_argument {
  my $s = shift;
  my $value;
  my $tail;
  $s = "" unless defined $s;
  $s =~ s/^(.*\S)\s*$/$1/;
  $s =~ s/^\s*(\S.*)$/$1/;
  return ("", "") if $s =~ /^\s*$/;
  if ( $s =~ /^\"/ ) {
    unless ( $s =~ /^\"([^\"]*(\\\"[^\"]*)*([^\\\"]|\\\\|\\\")|)\"(.*)$/  ) {
      print "$s\n";
      print "^--- Не закрытая двойная кавычка ...\n";
      return ();
    }
    $value	= $1;
    $tail	= $4;
  }
  elsif ( $s =~ /^([^\s\",]*)([\s\",].*)$/ ) {
    $value	= $1;
    $tail	= $2;
  }
  else {
    $value	= $s;
    $tail	= "";
  }
  $tail =~ s/^\s*(\S.*)$/$1/;
  $tail =~ s/^,(.*)$/$1/;
  $tail =~ s/^\s*(\S.*)$/$1/;
  $tail =~ s/^\s*$//;
  
  return ($value, $tail);
}
#========================================================================
# Настройка путей, имен файлов, и других глобальных переменных
#========================================================================
sub startup {

  $plus		= ord ('+')	;
  $minus	= ord ('-')	;
  $command	= ord ('c')	;
  $filter_all	= [$plus, '.*']	;
  $diff_filters	= {}		;
  $copy_filters = {}		;
  $file_filters = {}		;

  $cvs	= '/usr/bin/cvs'  ; return 0 unless check_executable ($cvs );
  $file	= '/usr/bin/file' ; return 0 unless check_executable ($file);
  $find	= '/usr/bin/find' ; return 0 unless check_executable ($find);
  $pwd	= '/bin/pwd'      ; return 0 unless check_executable ($pwd );

  my $full_name = full_path ($0);
  unless ( $full_name =~ /^(.*)\/backup\/bin\/([^\/]+)$/ ) {
    print "Нарушена   структура  каталогов  системы   резервного\n";
    print "копирования. Этот скрипт должен находиться в каталоге\n";
    print "\".../backup/bin\"\n";
    return 0;
  }
  $base_dir	= "$1/backup";
  $base_name	=  $2;
  $config	= "$base_dir/etc/$base_name";
  $spool	= "$base_dir/data/$base_name";

  return 0 unless check_dir     ($base_dir);
  return 0 unless check_cvsable ($spool   );
  return 0 unless check_access  ($config  );
  
  unlink $spool . "";

  return 1;
}
#========================================================================
# Экранирование спецсимволов при помощи символа '\'
#========================================================================
sub string_shield {
  my $string = shift;
  $string =~ s/\\/\\\\/g;
  $string =~ s/\"/\\\"/g;
  return $string;
}
#========================================================================
# Снятие экранирования спецсимволов при помощи символа '\'
#========================================================================
sub string_unshield {
  my $string = shift;
  $string =~ s/\\\\/\\/g;
  $string =~ s/\\\"/\"/g;
  return $string;
}
#########################################################################
#									#
#		    ---=== Config File Format ===---			#
#									#
# keywords								#
# --------								#
# secure : <filter definition> # diff filter				#
# save	 : <filter definition> # file coty filter			#
# mask	 : <filter definition> # file name filter			#
#									#
# file	 : "file name"[[,] [secure][[,] [save]]]			#
# tree	 : "path name"[[,] [mask][[,] [secure][[,] [save]]]]		#
#									#
# filter definition							#
# -----------------							#
# "name" alias   "alias"  # make filter "name" alias to filter "alias"	#
# "name" =       "alias"  # same as alias				#
# "name" add     "filter" # copy filter "filter" to filter "name"	#
# "name" ACCEPT  "regexp" # execute entries				#
# "name" +       "regexp" # same as ACCEPT				#
# "name" DROP    "regexp" # drop entries				#
# "name" REJECT  "regexp" # same as DROP				#
# "name" -       "regexp" # same as DROP				#
# "name" command "cmd"    # execute "cmd" with entries			#
# "name" cmd     "cmd"    # same as command				#
# "name" c       "cmd"    # same as command				#
#									#
#########################################################################
# End of file								#
#########################################################################