fetcher

   1 #!/usr/bin/perl -w
   2 #
   3 # 21.8.2000r (C) Andrzej Radecki
   4 #
   5 # Skrypt objêty licencj± GPL (General Public License)
   6 #
   7
   8
   9 use CGI;
  10 use CGI::Carp qw(fatalsToBrowser set_message);
  11 use strict;
  12
  13 BEGIN {
  14         sub handle_errors {
  15                 my $msg = shift;
  16                 if ($msg =~ /POSTs are limited to/) {
  17                         print "Zbyt du¿y killfile\n"
  18                 } else {print "Ooops.. czy¿by jaki¶ b³±d w skrypcie?\n$msg\n"}
  19         }
  20         set_message(\&handle_errors);
  21 }
  22
  23 use Fcntl ':flock';
  24
  25 $CGI::POST_MAX=20000;
  26 #$CGI::DISABLE_UPLOADS=1;
  27 my $q = new CGI;
  28 my $ident = "../ident"; #to musi byæ w bezpiecznym miejscu
  29 my $log_file = "../log";
  30 my $redirect = 'http://localhost';
  31 my $zip = '/usr/bin/zip';
  32 my $gzip = '/usr/bin/gzip';
  33 my $bzip2 = '/usr/bin/bzip2';
  34 my ($login_name, $pass, $compress, $uploaded_file, $debug);
  35 my (%groups, %crossposts, @messages, %killfile);
  36
  37
  38 loguj();
  39 parametry();
  40 if (autoryzuj()) {pobierz_newsy()}
  41
  42
  43
  44
  45 sub parametry {
  46 #       my ($blok, @tmp, $newsgroups, $old);
  47
  48         if ($q->param('compress')) {$compress = $q->param('compress'); $compress =~ s/\/$//;}
  49         else {$compress = 'bzip2'}
  50         if ($q->param('user')) {$login_name = $q->param('user'); $login_name =~ s/\/$//;}
  51         if ($q->param('pass')) {$pass = $q->param('pass'); $pass =~ s/\/$//;}
  52         if ($q->param('debug')) {$debug = $q->param('debug'); $debug =~ s/\/$//;}
  53         else {$debug = 'yes'}
  54
  55         my @groups = grep(/^count-.+/, $q->param());
  56 #       print @groups, "\n";
  57         %groups = map { /^count-(.+)/; $1 => $q->param($_); } @groups;
  58 #       print keys(%groups),' ', values(%groups), "\n";
  59         if ($q->param('killfile')) {$uploaded_file = $q->param('killfile'); $uploaded_file =~ s/\/$//;}
  60         return if ($login_name eq 'test' || !defined($uploaded_file)); #ograniczenie dla anonimów
  61
  62
  63         #parsujemy killfile
  64
  65         my $newsgroups = 'default';
  66         while (<$uploaded_file>) {
  67                 m/\r?\n?$/ || next; #obciêta ostatnia linia?
  68                 s/\r?\n?$//; #usuwamy znaki koñca linii
  69                 next if /^$/;
  70                 next if /^\s*#/;
  71                 s#/#\\/#g;   #eskejpujemy '/'
  72                 s/([\$\@\%])(?=.+)/\\$1/g; #j.w. ale $zmienna, @zmienna, %zmienna
  73                 s/\(\?.+?\)/$1/g; #wycinamy wszelkie rozszerzenia regexpów
  74
  75 #               push @messages, "$.: $_" if ($debug eq 'yes');
  76                 if (/^\[([a-z0-9\.+-]+)\]/) {$newsgroups = $1; next;}
  77                 if (/^(-?\d+):([\w_-]+?):(.+)/) {push @{$killfile{$newsgroups}}, [$1, $2, $3]; next;}
  78                 else {push @messages, "Syntax error in killfile (line $.)"; last;}
  79         }
  80
  81         if ($debug eq 'yes') {
  82                 foreach my $grupa (keys (%killfile)) {
  83                         foreach my $regulka (@{$killfile{$grupa}}) {
  84                                 my $tmp = join (':', @{$regulka});
  85                                 push @messages, "$grupa\t$tmp";
  86                         }
  87                 }
  88         }
  89 }
  90
  91 sub pobierz_newsy {
  92         use News::NNTPClient;
  93         my $c = new News::NNTPClient("localhost"); #, "", 2);
  94
  95         my ($first, $last);
  96         my $nr;
  97         my ($headers, $tmp);
  98         my %headers;
  99         $c->mode_reader();
 100         *WYJSCIE = *STDOUT;
 101         for (my $i=0; $i < scalar(@messages); $i++) {
 102                 print WYJSCIE "X-Notice-$i: $messages[$i]\r\n";
 103         }
 104 #       print WYJSCIE "X-Notice-1: test\r\n";
 105         if ($compress eq 'bzip2') {
 106                 print WYJSCIE $q->header(-type=>"application/octet-stream", "Content-Disposition"=>"filename=paczka.bz2");
 107                 open (WYJSCIE, "| $bzip2 -5");
 108         } elsif ($compress eq 'gzip') {
 109                 print WYJSCIE $q->header(-type=>"application/octet-stream", "Content-Disposition"=>"filename=paczka.gz");
 110                 open (WYJSCIE, "| $gzip -9q");
 111         } elsif ($compress eq 'zip') {
 112                 print WYJSCIE $q->header(-type=>"application/octet-stream", "Content-Disposition"=>"filename=paczka.zip");
 113                 open (WYJSCIE, "| $zip -9q");
 114         } else { print WYJSCIE $q->header(-type=>"application/octet-stream", "Content-Disposition"=>"filename=paczka.txt")}
 115
 116         my $count = 0;
 117         foreach my $grupa (keys (%groups)) {
 118                 $nr = $groups{$grupa};
 119                 ($first, $last) = ($c->group($grupa));
 120
 121                 if ($nr =~ /^\-(\d+)/) { $nr = $last - $1 }
 122                 if ($nr < $first) { $nr = $first }
 123                 $nr++;
 124 #               print "$first $last $nr \n";
 125
 126                 for (; $nr <= $last; $nr++) {
 127                         $c->{CMND} = "fetchbinary";
 128                         $headers = $c->command("HEAD $nr")."\015\012\015\012";
 129                         if ($c->ok()) {
 130                                 $tmp = $headers;
 131                                 $tmp =~ s/\015?\012\s+/ /g; #scalamy wieloliniowe naglowki
 132                                 %headers = map { /^(.+?): (.*)$/; $1 => $2; } split (/\015?\012/, $tmp);
 133                                 if (!killarticle(%headers)) {
 134                                         print (WYJSCIE $headers);
 135                                         $c->{CMND} = "fetchbinary";
 136                                         print (WYJSCIE $c->command("BODY $nr"), "\015\012.\015\012");
 137                                         $count++;
 138                                         exit if (($login_name eq 'test') && ($count >= 50)); #ograniczenie dla anonimów
 139                                 }
 140                         }
 141                 }
 142         }
 143         close (WYJSCIE);
 144 };
 145
 146 sub killarticle {
 147         my %hdrs = @_;
 148
 149 #eliminacja powielania crosspostow przy sciaganiu; %hdrs - hash naglowkow
 150         if (scalar(my @tmp = split (/ /, $hdrs{'Xref'})) > 2) {
 151 #       print "Xref: ", $hdrs{'Xref'}, scalar(@tmp = split (/ /, $hdrs{'Xref'})),"\n";
 152                 if (defined($crossposts{$hdrs{'Message-ID'}})) {return 1} #mamy powtórzony crosspost
 153                 else {$crossposts{$hdrs{'Message-ID'}} = 1}
 154         }
 155         return if ($login_name eq 'test'); #ograniczenie dla anonimów
 156
 157 #sprawdzanie killfile'a:
 158
 159
 160         my $count = 0;
 161         foreach my $grupa (split (/,/, $hdrs{'Newsgroups'})) {
 162                 if (defined($killfile{$grupa})) {
 163                         foreach my $regulka (@{$killfile{$grupa}}) {
 164 #                       print "   ", join('::', @{$regulka}),"->@{$regulka}[2]\n";
 165                                 if ($hdrs{@{$regulka}[1]} =~ /@{$regulka}[2]/i) {$count += @{$regulka}[0]};
 166                         }
 167                 }
 168         }
 169         if (defined($killfile{'default'})) {
 170                 foreach my $regulka (@{$killfile{'default'}}) {
 171 #               print "   ", join('::', @{$regulka}),"\n";
 172                         if ($hdrs{@{$regulka}[1]} =~ /@{$regulka}[2]/i) {$count += @{$regulka}[0]};
 173                 }
 174         }
 175         return 1 if ($count < 0);
 176 #       print "$count\r\n";
 177         return;
 178
 179 }
 180
 181
 182
 183 sub autoryzuj {
 184         open IDENT, $ident;
 185         flock IDENT, LOCK_EX;
 186         my @jest = grep ((/^$login_name/o), <IDENT>);
 187         flock IDENT, LOCK_UN;
 188         close IDENT;
 189
 190         if (@jest) {
 191                 if (($jest[0] =~ /^(.+) (\S+)$/) && ($2 eq crypt ($pass, $2))) {return 1};
 192                 $q->delete_all();
 193                 print $q->redirect($redirect);
 194                 exit;
 195         };
 196         if (! ($login_name) || ($login_name ne 'test')) {
 197                 $q->delete_all();
 198                 print $q->redirect($redirect);
 199                 exit;
 200         };
 201         return 1;
 202
 203 };
 204
 205 sub loguj {
 206         local $|=1;
 207         open(LOG, ">> $log_file");
 208         flock LOG, LOCK_EX;
 209         print LOG scalar(localtime(time)), "\t";#, join("\t",sort(grep(!/pass/, $q->param()))),"\n";
 210         foreach my $k (grep(!/^pass$/, $q->param())) {
 211                 print LOG "$k=", $q->param($k), " ";
 212         }
 213         print LOG "\n";
 214         flock LOG, LOCK_UN;
 215         close LOG;
 216 }