ru.linux

 
 - RU.LINUX ---------------------------------------------------------------------
 From : Kirill Frolov                        2:5030/827.2   13 Jul 2002  01:21:08
 To : Ilia Chirkov
 Subject : uue
 -------------------------------------------------------------------------------- 
 

 
 12 Jul 02 15:33, Ilia Chirkov wrote to Kirill Frolov:
 
  KF>>     Hайди перловый уудекодер by SLN. Спрашивай в ru.unix.ftn.
  IC> а тут разве никто не сможет помочь? нету у меня этой эхи.
 
     Версия старая, глючная...
 
 === Cut ===
 #!/usr/bin/perl -w
 
 # конфиг файл
 $config='/etc/fido/uudecode.conf';
 ### Pogramm ################################################### Don't touch ###
 use Fcntl;
 use GDBM_File;
 ##DB_File;
 
 $ver="UUE Decoder v0.41 (c) Sln !";
 # parse config #
 open(CFG, "< $config") || die "$config: $!\n";
 
 (%spoolpkt,%maskpkt,%file,%set,%echo)=();
 $i=0;
 
 while(<CFG>){
 
 $spooldec=$1        if /^decoded\s+(\S+)/i;
 $spoolpkt{$i}=$1    if /^pkt\s+(\S+)/i;
 $maskpkt{$i}=$1     if /^maskpkt\s+(\S+)/i;
 
 $file{log}=$1       if /^log\s+(\S+)/i;
 $file{res}=$1       if /^resource\s+(\S+)/i;
 $file{rec}=$1       if /^recode\s+(\S+)/i;
 $file{dup}=$1       if /^dupe\s+(\S+)/i;
 $file{sts}=[$1,$2]  if /^stat\s+(\S+)\s+([abc]{1,3})/i;
 $file{bbs}=$1       if /^filesbbs\s+(\S+)/i;
 
 $set{dos}=$1        if /^rendos\s+(\d)/i;
 $set{cmp}=$1        if /^rencomp\s+(\d)/i;
 $set{code}=$1       if /^rencode\s+(\d)/i;
 $set{dupe}=$1       if /^dupename\s+(\d)/i;
 $set{del}=$1        if /^delpkt\s+(\d)/i;
 $set{keep}=$1       if /^keepuue\s+(\d)/i;
 $set{rec}=$1        if /^recbbs\s+(\d)/i;
 $set{bad}=$1        if /^savebad\s+(\d)/i;
 $set{form}=$1       if /^formbbs\s+(.+)/i;
 $set{more}=$1       if /^delmore\s+(\d)/i;
 
 $echo{$i}=[$1,$2]   if /^echo\s+(\S+)\s+(\S+)/i;
 $i++;
 }
 close CFG;
 die "Check spool for decoded files (not def)\n" unless defined $spooldec;
 die "Check spool for incoming pkts (not def)\n" unless %spoolpkt;
 die "Check mask for incoming pkts\n"        unless %maskpkt;
 die "Check set any param from config\n"     if keys %set !=10;
 die "Echo mask not defined\n"           unless %echo;
 
 uplog("Starting $ver");
 if(exists $file{rec}){
 uplog("Loading recode file");
  open(CODE, "< $file{rec}") || errlog("$file{rec}: $!");
   $in=$out='';
    while(<CODE>){ $in.="\\$1",$out.="\\$2" if /^0+(x[\da-f]+)\s+0+(x[\da-f]+)/i 
 }
  close(CODE);
 }
 undef %uue;
 
 # load resorce file
 if(exists $file{res}){
  uplog("Loading resource file");
  tie (%res, 'GDBM_File', $file{res}, O_RDWR|O_CREAT, 0640) || errlog("dbmopen:
 $file{res}: $!");
   foreach(keys %res){
    @_=split /\0/, $res{$_},7;
    $uue{$_[0]}{$_[1]}{time} =$_[3];
    $uue{$_[0]}{$_[1]}{last} =$_[4];
    $uue{$_[0]}{$_[1]}{size} =$_[5];
    $uue{$_[0]}{$_[1]}{$_[2]}=$_[6];
   }
  untie %res ;
 }
 # load dupebase
 if(exists $file{dup}){
  uplog("Loading dupe base");
  tie (%dupe, 'GDBM_File', $file{res}, O_RDWR|O_CREAT, 0640) ||
 uplog("$file{dup}: $!");
 }
 # get pkts
 undef %pktbase;
 foreach $dir (sort {$a<=>$b} keys %spoolpkt){
  opendir(DIR, $spoolpkt{$dir}) || errlog("$spoolpkt{$dir}: $!");
   foreach $mask (values %maskpkt){
    rewinddir DIR;
    $mask=esc($mask);
    $pktbase{$_}=(stat($_))[7] foreach(map {"$spoolpkt{$dir}/$_"} grep
 {/^$mask$/i and -f "$spoolpkt{$dir}/$_"} readdir DIR);
   }
  close(DIR);
 }
 $i=0; $i+=$_ foreach(values %pktbase);
 1 while $i=~s/^(\d+)(\d{3})/$1.$2/;
 uplog("Found ".(keys %pktbase)." incoming pkt at $i bytes");
 undef %msgs;
 foreach $pkt (sort {$a cmp $b} keys %pktbase){
  open(PKT, "< $pkt") || uplog("$pkt: $!");
  binmode(PKT);
  pkthead() || uplog("Bad pkt struct '$pkt'");
  uplog("Scaning: $pkt ($pktbase{$pkt} bytes,
 $pkt{fromzone}:$pkt{fromnet}/$pkt{fromnode}.$pkt{frompnt} ->
 $pkt{tozone}:$pkt{tonet}/$pkt{tonode}.$pkt{topnt})");
  msgs();
  close(PKT);
 }
 undef %dec;
 foreach $area (sort {$a cmp $b} keys %uue){
 foreach $file (sort {lc($a) cmp lc($b)} keys %{$uue{$area}}){
 
 if((keys %{$uue{$area}{$file}})-3 > $uue{$area}{$file}{last}){
  uplog("Bad complete $file (".((keys %{$uue{$area}{$file}})-3)." section of
 $uue{$area}{$file}{last})");
  unless($set{more}){ delete $uue{$area}{$file}; next }
 }
 
 if((keys %{$uue{$area}{$file}})-3 >= $uue{$area}{$file}{last}){
  $dec=unpack("u", join '', map {$uue{$area}{$file}{$_}} sort {$a <=> $b} map
 {/^\d+$/ ? $_ : ()} keys %{$uue{$area}{$file}});
  uplog("Complete: $file (".(length $dec)." bytes, ".((keys
 %{$uue{$area}{$file}})-3)." section(s), area $area)");
 
  # chk bad decoded
  if($uue{$area}{$file}{size} == -1){
   $dec{ok}{$area}{$file}=[length $dec,$uue{$area}{$file}{last}];
  }else{
   if($uue{$area}{$file}{size} == length $dec){
    $dec{ok}{$area}{$file}=[length $dec,$uue{$area}{$file}{last}];
   }else{
    uplog("Bad decoded $file (expect ".$uue{$area}{$file}{size}." bytes, have
 ".(length $dec)." bytes)");
    $dec{bad}{$area}{$file}=[length $dec,$uue{$area}{$file}{size}];
    unless($set{bad}){
    uplog("Delete bad $file");
    delete $uue{$area}{$file};
    next;
    }
   }
  }
 
  delete $uue{$area}{$file};
  savefile($area,$file,$dec,$msgs{$area}{$file}->[0],$msgs{$area}{$file}->[1]) ;
 }else{
  uplog("Incomplete: $file (expect $uue{$area}{$file}{last}, have ".((keys
 %{$uue{$area}{$file}})-3)." section(s), area $area)");
  $dec{inc}{$area}{$file}=[$uue{$area}{$file}{last},(keys
 %{$uue{$area}{$file}})-3];
 }
 }
 }
 # save statistic
 if(exists $file{sts} and %dec){
 
 undef $stat;
 
 # normal
 if(exists $dec{ok} and $file{sts}->[1]=~/a/i){
 $stat.="\nComplete:\n";
 foreach $area (sort {$a cmp $b} keys %{$dec{ok}}){
 $stat.=">".uc($area)."\n";
 foreach $file (sort {lc($a) cmp lc($b)} keys %{$dec{ok}{$area}}){
 $stat.=f2s(a2k($file)).s2s($dec{ok}{$area}{$file}->[0])."bytes,
 $dec{ok}{$area}{$file}->[1] section(s)\n";
 }
 }
 }
 # bad
 if(exists $dec{bad} and $file{sts}->[1]=~/b/i){
 $stat.="\nBad decoded:\n";
 foreach $area (sort {$a cmp $b} keys %{$dec{bad}}){
 $stat.=">".uc($area)."\n";
 foreach $file (sort {lc($a) cmp lc($b)} keys %{$dec{bad}{$area}}){
 $stat.=f2s(a2k($file)).s2s($dec{bad}{$area}{$file}->[0])."bytes, expect
 $dec{bad}{$area}{$file}->[1] bytes\n";
 }
 }
 }
 # incomplete
 if(exists $dec{inc} and $file{sts}->[1]=~/c/i){
 $stat.="\nIncomplete:\n";
 foreach $area (sort {$a cmp $b} keys %{$dec{inc}}){
 $stat.=">".uc($area)."\n";
 foreach $file (sort {lc($a) cmp lc($b)} keys %{$dec{inc}{$area}}){
 $stat.=f2s(a2k($file)).s2s($dec{inc}{$area}{$file}->[1])."section(s) of
 $dec{inc}{$area}{$file}->[0]\n";
 }
 }
 }
 if($stat){
 open(STS,"> $file{sts}->[0]") || uplog("$file{sts}->[0]: $!");
 print STS "$stat\n\n$ver\n";
 close(STS);
 }
 
 }
 # save dupebase
 if(exists $file{dup}){
  uplog("Saving dupe base");
  untie %dupe || uplog("$file{dup}: $!");
 }
 # save resorce file
 if(exists $file{res}){
 unlink $file{res};
 uplog("Saving resource file");
 tie (%res, 'GDBM_File', $file{res}, O_RDWR|O_CREAT, 0640) || errlog("$file{res}:
 $!");
 undef %res;$i=0;
  foreach $area (sort {$a cmp $b} keys %uue){
  foreach $file (sort {lc($a) cmp lc($b)} keys %{$uue{$area}}){
 
   # delete old uues
   if($uue{$area}{$file}{time} < $set{keep}*86400){
   uplog("Remove section for old $file");
   delete $uue{$area}{$file};
   next;
   }
 
    foreach $sec  (sort {$a <=> $b} map {/^\d+$/ ? $_ : ()} keys
 %{$uue{$area}{$file}}){
    $res{$i++}="$area\0$file\0$sec\0$uue{$area}{$file}{time}\0$uue{$area}{$fil
 e}{last}\0$uue{$area}{$file}{size}\0$uue{$area}{$file}{$sec}";
    }
  }
  }
 untie %res ;
 }
 # unlink pkts
 if($set{del} and %pktbase){
 uplog("Remove pkt");
 foreach(keys %pktbase){
 unlink $_ || uplog("$_: $!");
 }
 }
 uplog("Exit 0\n");
 exit 0;
 sub uplog{
 return unless exists $file{log};
 my $str=shift;
 @_=localtime();
 open(LOG, ">> $file{log}") || die $!;
 print LOG sprintf("%02d/%02d/%02d %02d:%02d:%02d uuedec [$$]
 $str\n",$_[3],$_[4],substr($_[5],-2),$_[2],$_[1],$_[0]);
 close LOG;
 }
 sub errlog{
 uplog($_[0]);
 uplog("Exit 1");
 exit 1;
 }
 sub esc{
 my $str=shift;
 $str=~s/(\W)/\\$1/g;
 $str=~s/\\\*/\.*/g;
 $str=~s/\\\?/\./g;
 $str;
 }
 sub pkthead{
  undef %pkt;
  read PKT, $_, 58;
  return 0 unless length $_ == 58;
  @pkt{'fromnode','tonode','year','month','day','hour','min','sec','rate','ver
 ','fromnet','tonet','prodx','password',
       'fromzone','tozone','filler','capvalid','prodcode','capword','fromzone'
 ,'tozone','frompnt','topnt','proddata'}=unpack "vvvvvvvvvvvvvA8vvvvvvvvvvV",$_;
 }
 sub msgs{
  while(msghead()){
  msgrb();
  }
 }
 sub msghead{
  undef %msg;
  read PKT, $_, 14;
  @msg{'type','fromnode','tonode','fromnet','tonet','flags','dummy'} = unpack
 "vvvvvvv", $_;
  return 0 unless defined $msg{type};
  return 0 if $msg{type} == 0;
  @msg{'date','to','from','subj','area'}=(msgrh(),msgrh(),msgrh(),msgrh(),msgr
 a());
  1;
 }
 sub msgrh{
  my $str='';
  while(read PKT, $_, 1){ (ord($_) == 0) ? last : ($str.=$_) }
  $str;
 }
 sub msgra{
  my $str='';
  my $pos=tell PKT;
  read PKT, $_, 12;
  seek PKT, $pos, 0;
  if(/^area:netmail$/i or !/^area:/i){ return "netmail" }
  while(read PKT, $_, 1){ (ord($_) == 13) ? last : ($str.=$_) }
  lc(substr $str, 5);
 }
 sub msgrb{
 my @body=split /[\r\n]+/, msgrh();
 
 return unless defined areapath($msg{area});
 
 my $i;
 
 for($i=0;$i<@body;$i++){
 
  # uue 'section num of num of file file.name'
  $i=getuue($i,$1,$2,$3,@body), next if
 $body[$i]=~/^section\s+(\d+)\s+of\s+(\d+)\s+of file\s+(\S+)/i;
 
  # uue 'section num ... of file file.name'
  $i=getuue($i,$1, 1,$2,@body), next if $body[$i]=~/^section\s+(\d+).*\s+of
 file\s+(\S+)/i;
 
  # uue 'begin num file.name'
  $i=getuue($i, 1, 1,$1,@body), next if $body[$i]=~/^begin\s+\d+\s+(\S+)/i;
 
 }
 
 }
 sub getuue{
 my ($i,$cur,$last,$file,@uue)=@_;
 my $j;
 
  # get 1st pos of uue
  for ($i=$i;$i<@uue;$i++){
   last if $uue[$i]=~/^M/;
   return $i if $uue[$i]=~/^(sum|end)/i or length $uue[$i] <= 1 or $i-1 > @uue;
  }
  # get uue code
  for($i=$i;$i<@uue;$i++){
   last if $uue[$i]=~/[\x00-\x1F\x61-\xFF]/ or length $uue[$i] <= 1;
   $uue{$msg{area}}{$file}{$cur}.=$uue[$i]."\n";
  }
  # if uue line not found
  return $i unless exists $uue{$msg{area}}{$file}{$cur};
  # detect checksum at last section
  if($cur == $last){
   for $j($i..$i+5){
   last unless defined $uue[$j];
   $uue{$msg{area}}{$file}{size}=$1 if $uue[$j]=~/^sum\s+\S+\s+\d+\/(\d+)/i;
   }
  }
 $uue{$msg{area}}{$file}{last}=$last;
 $uue{$msg{area}}{$file}{time}=time();
 $uue{$msg{area}}{$file}{size}=-1 unless exists $uue{$msg{area}}{$file}{size};
 $msgs{$msg{area}}{$file}=[$msg{subj},$msg{from}];
 
 uplog("Trying: $file (section $cur of $last, area $msg{area})");
 
 return $i;
 }
 sub areapath{
 my $echo=shift;
 
 foreach $i (sort {$a<=>$b} keys %echo){
 $mask=esc($echo{$i}->[0]);
  if($echo=~/^$mask$/i){
   return $echo if $echo{$i}->[1] eq '*';
   return $echo{$i}->[1];
  }
 }
 
 return undef;
 }
 sub a2k{
 my $str=shift;
 return $str unless exists $file{rec};
   eval "\$str=~tr/$in/$out/";
 $str;
 }
 sub f2s{ " ".substr($_[0],0,15)." "."."x(15-length $_[0]) }
 sub s2s{ "."x(8-length $_[0])." $_[0] " }
 sub savefile{
 local ($area,$file,$dec,$subj,$nfrom)=@_;
 $forig=$file;
 # detect dupes and update dupebase
 if(exists $file{dup}){
   if(exists $dupe{lc($file)} and $dupe{lc($file)} == length $dec){
   uplog("Skip dupe $file (".(length $dec)." bytes, area $area)");
   return;
   }
  $dupe{lc($file)}=length $dec;
 }
 # bad file name
 if($set{cmp}){
 $file=~s/[\x00-\x20\xB0-\xDF\xF2-\xFF"*\/:<>?\\\|]/_/g;
 }
 # file name translate
 if($set{code} == 2){
  $file=~tr/ДіЪїАЩГґВБЕЯЬЭЮ°±ІфющышхяэНєХёЦЙё·»ФУИѕЅјЖЮАБЦДЕФЛКЙМ/ABVGDEJZIIK
 LMNOPRSTUFHC'A'Aabvgdejziiklmnoprstufhc'a'a/;
  $file=~s/П/YO/;
  $file=~s/ч/CH/;
  $file=~s/у/SH/;
  $file=~s/т/SCH/;
  $file=~s/ъ/IU/;
  $file=~s/ц/YA/;
  $file=~s/Я/yo/;
  $file=~s/Г/ch/;
  $file=~s/Х/sh/;
  $file=~s/И/sch/;
  $file=~s//iu/;
  $file=~s/О/ya/;
 }
 $file=a2k($file) if $set{code} == 1;
 # convert filename dos compat (and upper case)
 if($set{dos}){
  $file=uc($file);
  if($file=~s/\.//g){
   @_=(substr($`,0,8), substr($',0,3));
   $_[0]=~s/\./_/g;
   $file=$_[0].($_[1] ? ".".$_[1] : "");
  }else{
   $file=substr $file,0,8;
 }
 }
 # check file on disk
 $_=areapath($area) || return;
 $path="$spooldec/$_/";
 
 if(-f $path.$file and $set{dupe} == 0){uplog("Skip $file (file exists on
 disk)"); return }
 
 uplog("Overwrite $file (existinging file on disk)") if -f $path.$file and
 $set{dupe} == 1;
 if(-f $path.$file and $set{dupe} == 2){
 $count='000';
 uplog("Rename $file (file exists on disk)");
  while(){
   $file=~s/\.//g ? ($file="$`.$count") : ($file.=".$count");
   -f $path.$file ? ($count++) : last;
   if($count eq "1000"){ $count="000"; $file="$`.$count"; last }
  }
 }
 # save file
 unless(-d $path){ mkdir($path, 0755) || errlog("$path: $!") }
 uplog("Write: $path$file");
  open(DEC, "> $path$file") || errlog("$path$file: $!");
  binmode DEC;
  syswrite(DEC, $dec, length $dec);
  close(DEC);
 # update filebbs
 return unless exists $file{bbs};
 uplog("Update $path$file{bbs}");
 
 $form=$set{form};
 
 $form=~s/%f/$file/g;
 $form=~s/%o/$forig/g;
 $form=~s/%s/$subj/g;
 $form=~s/%n/$nfrom/g;
 $form=~s/%y/$area/g;
 $_=length $dec;
 $form=~s/%r/$_/g;
 $form=~s/%l/\n/g;
 
 $bbs='';
 @line=split /[\n\r]/,$form;
 foreach(@line){
  /%(\d+)/;
  @_=split /%$1/,$_,2;
  $bbs.=substr($_[0],0,$1)." "x($1-length $_[0]).$_[1]."\n";
 }
 
 $bbs=a2k($bbs) if $set{rec};
 
 open(BBS, ">> $path$file{bbs}") || errlog("$path$file{bbs}: $!");
 print BBS $bbs;
 close BBS;
 }
 === Cut ===
 --- [ZX]
  * Origin: на пц мы ставим крест, speccy поколенье next! (2:5030/827.2)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор 

Тема:    Автор:    Дата:    uue   Ilia Chirkov   29 Jun 2002 18:22:04   uue   Valentin Ermolaev   30 Jun 2002 11:55:57   uue   Ilia Chirkov   02 Jul 2002 01:20:38   uue   Valentin Ermolaev   02 Jul 2002 16:37:30   uue   Ilia Chirkov   04 Jul 2002 01:31:38   uue   vasiliy voyakin   01 Jul 2002 18:27:05   uue   Ilia Chirkov   02 Jul 2002 01:13:50   uue   vasiliy voyakin   02 Jul 2002 01:44:25   uue   Alexander Topolskiy   06 Jul 2002 15:11:30   uue   Ilia Chirkov   10 Jul 2002 01:13:34   uue   Alexander Topolskiy   16 Jul 2002 02:39:02   uue   Mike Yaroshevitch   16 Jul 2002 09:02:46   uue   Ilia Chirkov   17 Jul 2002 22:00:18   uue   Alexander Topolskiy   06 Jul 2002 14:55:08   uue   Ilia Chirkov   10 Jul 2002 01:09:58   uue   Kirill Frolov   10 Jul 2002 14:19:14   uue   Ilia Chirkov   12 Jul 2002 15:33:44   uue   Kirill Frolov   13 Jul 2002 01:21:08   Re: uue   Yury Lyakh   15 Jul 2002 12:56:12   uue   Alexander Topolskiy   16 Jul 2002 02:38:12