1# Local defines 2 3sub msgdb { return "c:\\fido\\hpt\\dupebase\\plduper.db"; } 4sub pktdb { return "c:\\fido\\hpt\\dupebase\\plduperpkt.db"; } 5sub nldb { return "c:\\fido\\nodelist\\nodelist.db"; } 6sub faq { return "c:\\fido\\itrack\\faq\\"; } 7 8sub route94 { return "c:\\user\\gul\\work\\routing\\route.94"; } 9sub sechubs { return "c:\\fido\\nodelist\\2nd_hubs.463"; } 10sub echol463 { return "c:\\user\\gul\\work\\echolist.463"; } 11sub listdir { return "c:\\fido\\hpt\\"; } 12sub listname { return "5020_238.avl" if $_[0] eq "2:5020/238"; 13 return "5020_1381.avl" if $_[0] eq "2:5020/1381"; 14 return "94.avl" if $_[0] eq "2:463/94"; 15 return "58.avl" if $_[0] eq "2:463/58"; 16 return ""; 17 } 18 19sub maillists { return ( 20 "Staff", 21 "Postmaster", 22 "Admin", 23 "Noc", 24 "Hostmaster", 25 "Cert", 26 "Bugtraq", 27 "Mutt-dev", 28 "Registry" 29 ); } 30 31use DB_File; 32use Fcntl ":flock"; 33use POSIX; 34 35#use strict; 36 37# predefined variables 38#my($fromname, $toname, $fromaddr, $toaddr, $subject, $date, $text, $attr); 39#my($secure, $pktname, $rc, $res, $area, $pktfrom, $addr, $from); 40#my($kill, $change, $flavour); 41 42# My global variables 43my(%nodelist, $nltied); 44my(%pkt, $pkttied, %msg, $msgtied, $newnet, $newecho, @crc_32_tab); 45my($processpktname, $pktkey, $pktval, %msgpkt, $curnodelist, @areas); 46 47sub filter 48{ 49# predefined variables: 50# $fromname, $fromaddr, $toname, 51# $toaddr (for netmail), 52# $area (for echomail), 53# $subject, $text, $pktfrom, $date, $attr 54# $secure (defined if message from secure link) 55# return "" or reason for moving to badArea 56# set $kill for kill the message (not move to badArea) 57# set $change to update $text, $subject, $fromaddr, $toaddr, $fromname, $toname 58 my(@hf, @mypoints, @lines, $firstpath, $lastpath, @path, $origin); 59 my(@lastpath, $net, @origin, $msgid, $msgidfrom, $approved, $path); 60 my($key, $oldval, $fromboss, $toboss, $knownpoint, $fname, $time, @myaddr); 61 my($oldtime, $oldpath, $oldpktfrom, $curtime, $dupetext, @roechoes); 62 local(*F); 63 @hf = qw( 64 2:5020/113 65 2:5020/32 66 2:5020/140 67 2:5020/50.40 68 2:5020/50.140 69 2:5020/140.1 70 2:5020/35 71 2:5020/35.1 72 2:5000/13 73 2:5000/44 74 2:5020/293 75 2:5020/1040 76 2:5020/443 77 2:5020/517 78 ); 79 @mypoints = qw( 80 2:463/68 81 2:463/68.1 # Yutta 82 2:463/68.2 # son 83 2:463/68.3 # Bor Mal 84 2:463/68.4 # Voronov 85 2:463/68.5 # Ksyu 86 2:463/68.8 # Sergey Iovov (/8.2) 87 2:463/68.9 # Kussul 88 2:463/68.11 # Brun 89 2:463/68.12 90 2:463/68.13 # Maxim Obukhov 91 2:463/68.17 # Kalina 92 2:463/68.18 # Andrew Ilchenko 93 2:463/68.26 # Dmitry Rachkovsky 94 2:463/68.27 # Andrey Zinin 95 2:463/68.28 # Jean Kantoroff <jean@acalto.dial.intercom.it> 96 2:463/68.32 # dk 97 2:463/68.36 # Valentin Klinduh 98 2:463/68.41 # Motus 99 2:463/68.45 # Artem Kulakov Sergei Shevyryov <megamed@wantree.com.au> 100 2:463/68.47 # Parkhom 101 2:463/68.50 # Rozhko 102 2:463/68.62 # Victor Cheburkin /62 103 2:463/68.67 # Alexey Suhoy /67 104 2:463/68.92 # Andrey Ichtchenko 105 2:463/68.108 # Vitaliy Oleynik 106 2:463/68.114 # ������� ���������� � ������� ��������� ��������� 107 2:463/68.128 # gate 108 2:463/68.141 # Sergey Skorodinsky <ssv@i.am> 109 2:463/68.163 # Den Dovgopoly 110 2:463/68.196 # Tverskaya flat 111 2:463/68.200 # Michael Bochkaryov 112 2:463/68.586 # eug@lucky.net 113 2:463/68.690 # Al Poduryan 114 2:463/68.702 # Miroslav Narosetsky 115 ); 116 @roechoes = qw( 117 1072.Compnews 118 BOCHAROFF.MUST.DIE 119 BOCHAROFF.UNPLUGGED 120 DIG.LINUX 121 JET.PHRASES 122 HUMOR.FILTERED 123 GUITAR.SONGS.FILTERED 124 OBEC.FILTERED 125 PVT.EXLER.FILTERED 126 RU.ANEKDOT.FILTERED 127 RU.ANEKDOT.THE.BEST 128 RU.AUTOSTOP.INFO 129 RU.SPACE.NEWS 130 RU.UFO.THEORY 131 RU.WINDOWS.NT.NEWS 132 SPB.HUMOR 133 SPB.SYSOP.FILTERED 134 SU.CRISIS.SITUATION 135 SU.FORMULA1.INFO 136 SU.OS2.FAQ 137 SU.WIN95.NEWS 138 ); 139 140 @myaddr = &myaddr; 141 if (defined($area)) 142 { 143 unless ($pktfrom =~ /^(2:463\/94(\.0)?|2:5020\/238(\.0)?)$/) 144 { # from downlink 145 foreach(@roechoes) 146 { 147 if ($area eq $_) 148 { 149 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 150 $subject, $date, "pvt sent read", 151 "hpt> Posting to r/o echo $area\r" . $text, 0); 152 $kill = 1; 153 return "Posting to r/o echo $area"; 154 } 155 } 156 } 157 $text =~ s/\r\n/\r/gs; 158 @lines = split('\r', $text); 159 $firstpath = $lastpath = $origin = $msgidfrom = ""; 160 @path = grep(/^\x01PATH: /, @lines); 161 $firstpath = "2:$1" if $path[0] =~ /^\x01PATH: (\S+)/; 162 $lastpath = pop(@path); 163 $lastpath =~ s/^\x01PATH: //; 164 @lastpath = split(/\s+/, $lastpath); 165 foreach(@lastpath) 166 { $net = $1 if m#^(\d+)/\d+$#; 167 $_ = "$net/$_" if /^\d+$/; 168 $lastpath = $_; 169 } 170 $lastpath = "2:$lastpath" if $lastpath; 171 @lastpath = (); 172 @origin = grep(/^ \* Origin: .*\(.*\)\s*$/, @lines); 173 if (@origin) 174 { $origin = pop(@origin); 175 @origin = (); 176 if ($origin =~ /\(([0-9:\/\.]+)(\@[A-Za-z0-9.\-]+)?\)\s*$/) 177 { $origin = $1; 178 } else 179 { undef($origin); 180 @origin = (); 181 } 182 } 183 ($msgid) = grep(/^\x01MSGID:/, @lines); 184 $msgidfrom = $1 if $msgid =~ /^\x01MSGID: ([0-9:\/\.])+(\@\S+)? /; 185 if ($area eq "HUMOR.FILTERED") 186 { 187 $approved = 0; 188 foreach (@hf) 189 { $approved = 1 if $firstpath eq $_ || $origin eq $_ || $msgidfrom eq $_; 190 } 191 unless ($approved) 192 { 193 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 194 $subject, $date, "pvt sent read", 195 "hpt> Unapproved message in $area\r" . $text, 0); 196 $kill = 1; 197 return "Unapproved message in $area"; 198 } 199 } 200 elsif ($area =~ /^PVT\.EXCH\./) 201 { unless ($lastpath =~ m/^2:50/) 202 { if ($origin =~ /^2:46/) 203 { 204 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 205 $subject, $date, "pvt sent read", 206 "hpt> R46 is r/o in PVT.EXCH.*\r" . $text, 0); 207 $kill = 1; 208 return "R46 is r/o in PVT.EXCH.*"; 209 } 210 } 211 } 212 elsif ($area eq "NET463.COORD") 213 { if ($fromname eq "Routing Poster" && $fromaddr eq "2:463/94.0") 214 { if (open(F, ">".route94)) 215 { foreach(grep(!/^(\x01|SEEN-BY:)/, @lines)) 216 { print F "$_\n"; 217 } 218 close(F); 219 } 220 } 221 } 222 elsif ($area eq "N463.SYSOP" && $fromname eq "N463EC" && $fromaddr eq "2:463/11.0") 223 { $fname = ""; 224 if ($subject eq "secondaries") 225 { $fname = sechubs; 226 } elsif ($subject eq "echolist") 227 { $fname = echol463; 228 } 229 if ($fname && open(F, ">$fname")) 230 { foreach(grep(!/^(\x01|SEEN-BY:)/, @lines)) 231 { print F "$_\n"; 232 } 233 close(F); 234 } 235 } 236 # Dupecheck 237 unless ($msgtied) 238 { 239 if (tie(%msg, 'DB_File', msgdb, O_RDWR|O_CREAT, 0644)) 240 { $msgtied = 1; 241 } else 242 { $newecho = 1; 243 return ""; 244 } 245 } 246 if ($msgid) 247 { $msgid =~ s/^\x01MSGID:\s*//; 248 $msgid =~ tr/A-Z/a-z/; 249 } 250 else 251 { $msgid = sprintf("C%s %08x", $fromaddr, crc32($date . join(' ',grep(!/^(\x01PATH|SEEN-BY):/,@lines)))); 252 } 253 $key = "$area|$msgid|" . crc32($fromname . $toname . $subject); 254 $path = ""; 255 foreach(grep(/^\x01PATH: /, @lines)) 256 { s/^\x01PATH:\s*//; 257 $path .= " " if $path; 258 $path .= $_; 259 } 260 $curtime = time(); 261 if (defined($msg{$key}) || defined($msgpkt{$key})) 262 { # Dupe 263 if (defined($msg{$key})) 264 { $oldval = $msg{$key}; 265 } else 266 { $oldval = $msgpkt{$key}; 267 } 268 ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $oldval); 269 $dupetext = <<EOF; 270Pkt from: $pktfrom 271Original pkt from: $oldpktfrom 272Original PATH: $oldpath 273$text 274EOF 275 putMsgInArea("DUPES", $fromname, $toname, $fromaddr, "", 276 $subject, $date, "pvt sent read", $dupetext, 0); 277 $kill = 1; 278 return "Dupe"; 279 } 280 $msgpkt{$key} = "$curtime|$path|$pktfrom"; 281 $newecho = 1; 282 return ""; 283 } 284 # NetMail 285 $fromaddr =~ s/\.0$//; 286 $toaddr =~ s/\.0$//; 287 $fromboss = $fromaddr; 288 $fromboss =~ s/\.\d+$//; 289 $toboss = $toaddr; 290 $toboss =~ s/\.\d+$//; 291 if ($secure) 292 { compileNL() unless $nltied; 293 if ($nltied && !defined($nodelist{$toboss})) 294 { bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, 295 "Node $toboss mising in $curnodelist"); 296 $kill = 1; 297 return "Node $toboss mising in $curnodelist"; 298 } 299 } 300 else 301 { if (isattr("att", $attr)) 302 { 303 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 304 $subject, $date, "pvt sent read", 305 "hpt> FileAttach from unsecure link\r" . $text, 0); 306 $kill = 1; 307 return "FileAttach from unsecure link"; 308 } 309 if ($fromaddr =~ /^(2:463\/68|2:46\/128)(\.\d+)?$/) 310 { 311 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 312 $subject, $date, "pvt sent read", 313 "hpt> Unprotected message from my system\r" . $text, 0); 314 $kill = 1; 315 return "Unprotected message from my system"; 316 } 317 compileNL() unless $nltied; 318 if ($nltied && !defined($nodelist{$fromboss})) 319 { 320 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 321 $subject, $date, "pvt sent read", 322 "hpt> Unprotected message from inlisted system\r" . $text, 0); 323 $kill = 1; 324 return "Unprotected message from unlisted system"; 325 } 326 unless ($toaddr =~ /^(2:463\/68(\.\d+)?|2:46\/128(\.\d+)?|2:463\/59\.4|17:.*)$/) 327 { bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, 328 "Unprotected outgoing message"); 329 putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr, 330 $subject, $date, "pvt sent read", 331 "hpt> Unprotected outgoing message\r" . $text, 0); 332 $kill = 1; 333 return "Unprotected outgoing message"; 334 } 335 } 336 if ($toboss eq $myaddr[0]) 337 { 338 $knownpoint = 0; 339 foreach(@mypoints) 340 { $knownpoint = 1 if $_ eq $toaddr; 341 } 342 unless ($knownpoint) 343 { bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, 344 "Unknown point"); 345 putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr, 346 $subject, $date, "pvt sent read", 347 "hpt> Unknown point\r" . $text, 0); 348 $kill = 1; 349 return "Unknown point"; 350 } 351 } 352 if ($toaddr eq $myaddr[0]) 353 { # check maillists 354 foreach (maillists) 355 { if ($toname eq $_) 356 { s/ //; 357 tr/A-Z/a-z/; 358 s/^(........).*$/$1/; 359 putMsgInArea($_, $fromname, $toname, $fromaddr, $toaddr, 360 $subject, $date, "pvt sent read", $text, 0); 361 $kill = 1; 362 return "Maillist $toname"; 363 } 364 } 365 if ($toname =~ /^ping$/i) 366 { 367 if (isattr("cpt", $attr)) 368 { 369 putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr, 370 $subject, $date, "pvt sent read", 371 "hpt> Ping request with RRC\r" . $text, 0); 372 $kill = 1; 373 return "Ping request with RRC"; 374 } 375 $text =~ s/\r\x01/\r\@/gs; 376 $text =~ s/^\x01/\@/s; 377 $time = localtime; 378 $text = <<EOF; 379 Hello $fromname. 380 381Your ping-message received by my system at $time 382 383Orignal message: 384 385============================================================================ 386FROM: $fromname $fromaddr 387TO : $toname $toaddr 388SUBJ: $subject 389DATE: $date 390============================================================================ 391$text 392============================================================================ 393EOF 394 putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr, 395 "Ping Reply", "", "pvt k/s loc cpt", $text, 1); 396 $newnet = 1; 397 $kill = 1; 398 return "Ping from $fromaddr"; 399 } 400 if ($toname =~ /^faqserver$/i) 401 { 402 if (isattr("cpt", $attr)) 403 { 404 putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr, 405 $subject, $date, "pvt sent read", 406 "hpt> FaqServer request with RRC\r" . $text, 0); 407 $kill = 1; 408 return "FaqServer request with RRC"; 409 } 410 faqserv($fromaddr, $fromname, $subject, $text); 411 $newnet = 1; 412 $kill = 1; 413 return "Message to FaqServer"; 414 } 415 if (($fromname =~ /^(areafix|gecho|crashecho|areafix daemon|sqafix)$/i || 416 $fromname =~ /echo manager/) && 417 listname($fromaddr) ne "" && 418 ($subject =~ /^(List request|List of areas available|List of available areas|AreaFix list of areas|AreaFix response|[Aa]reafix reply: (list request|available areas))/ || 419 $subject =~ /^Your Areafix Request$/ && $text =~ /Areas available to|\001SPLITTED:/s && $text =~ /\r\n? \S+\r/s || 420 $subject =~ /^Remote request operation report/ && $text =~ /areas available for|continued from the previous message/s || 421 $subject =~ /Reply from Parma Tosser Echo Manager, part/)) 422 { 423 if ($subject eq "AreaFix response" && $text =~ /\r\n?%LIST.*\r\n?--- CrashEcho's AreaFix/s) 424 { $kill = 1; 425 return "CrashEcho's areafix response"; 426 } 427 if (@areas) 428 { if ($areas[0] ne $fromaddr) 429 { putlist(); 430 @areas=($fromaddr); 431 } 432 } 433 else 434 { @areas=($fromaddr); 435 } 436 foreach (split(/\s*\r\n?/, $text)) 437 { 438 next if /^(\x01|SEEN-BY:)/; 439 if ($subject =~ /^AreaFix list of areas/) # CrashEcho 440 { if (/^ {15,}(\S(?:.*\S)?)\s+(?:\?|\d+)\s*$/ && $areas[1]) 441 { $areas[@areas-1] .= " $1"; 442 next; 443 } 444 } 445 elsif (/^ {15,}(\S.*)$/ && $areas[1] && $subject =~ /Parma Tosser/) 446 { $areas[@areas-1] .= " $1"; # or "$1", without space? 447 next; 448 } 449 elsif (/^ {15,}(\S.*)$/ && $areas[1]) 450 { $areas[@areas-1] .= " $1"; 451 next; 452 } 453 if ($subject =~ /^List request/) 454 { # FastEcho 455 next unless /^[\* ] (\S+)(?:(?: \.*)? (\S.*))?\s*$/; 456 push (@areas, "$1 $2"); 457 next; 458 } 459 if ($subject =~ /^List of areas available/) 460 { # FastEcho 461 next unless /^([^() \*\'\-\[][^() *]*)(?: \.+ (\S.*))?\s*$/; 462 push (@areas, "$1 $2"); 463 next; 464 } 465 if ($subject =~ /^List of available areas/) 466 { # GEcho 467 next unless /^[+ ](\S+)(?: +(\S.*))?\s*$/; 468 next if /^ '[+-]'/; 469 push (@areas, "$1 $2"); 470 next; 471 } 472 if ($subject =~ /^AreaFix list of areas/) 473 { # CrashEcho 474 next if /^ Group:/; 475 next unless /^ (\S+)(?:\s+(\S(?:.*\S)?)?\s+(?:\?|\d+))?\s*$/; 476 push (@areas, "$1 $2"); 477 next; 478 } 479 if ($subject =~ /^Your Areafix Request/) 480 { # Fidogate 481 next unless /^[ *] [ R] (\S+)\s*$/; 482 push (@areas, $1); 483 next; 484 } 485 if ($subject =~ /^[Aa]reafix reply: list request/) 486 { # hpt 487 next unless /^[* ][R ]? (\S+)(?: \.* (\S.*))?\s*$/; 488 push (@areas, "$1 $2"); 489 next; 490 } 491 if ($subject =~ /^[Aa]reafix reply: available areas/) 492 { # hpt 493 next unless /^ (\S+)(?: \.* (\S.*))?\s*$/; 494 push (@areas, "$1 $2"); 495 next; 496 } 497 if ($subject =~ /^Remote request operation report/) 498 { # SqaFix 499 next unless /^(\S+) \.+ (?:Unlinked|Active ) \[\S\](?: (\S.*\S))?\s*$/; 500 push (@areas, "$1 $2"); 501 } 502 if ($subject =~ /Parma Tosser/) 503 { # Parma Tosser 504 next if /^(Splitted by|--- |UpLink |Available areas|List of|Hello |Parma )/; 505 if (/^([A-Za-z\.&\$0-9!'_\+\-]+)(?:(?: \.+)?\s+(\:Unlinked|Lined)\s+\[.\] (.*))?$/) 506 { push(@areas, "$1 $2"); 507 } 508 } 509 } 510 $kill=1; 511 return "List reply"; 512 } 513 if ($toname =~ /^(areafix|allfix|filefix)$/i) 514 { 515 if (isattr("cpt", $attr)) 516 { 517 putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr, 518 $subject, $date, "pvt sent read", 519 "hpt> $toname request with RRC\r" . $text, 0) || 520 ($kill = 1); 521 return "$toname request with RRC"; 522 } 523 } 524 else 525 { 526 if (isattr("rrq", $attr) || isattr("arq", $attr)) 527 { receipt($fromaddr, $toaddr, $fromname, $toname, $subject, $date); 528 } 529 putMsgInArea("GUL", $fromname, $toname, $fromaddr, $toaddr, 530 $subject, $date, "pvt sent read", $subject, $text, 0) || 531 ($kill = 1); 532 return "Message to gul"; 533 } 534 } 535 else 536 { # Transit message 537 # Dupe- and loop- check 538 opendupe(); 539 if ($msgtied) 540 { 541 ($msgid) = grep(/^\x01MSGID:/, @lines); 542 if ($msgid) 543 { $msgid =~ s/^\x01MSGID:\s*//; 544 $msgid =~ tr/A-Z/a-z/; 545 } 546 else 547 { $msgid = sprintf("C%s %08x", $fromaddr, crc32($date . join(' ',grep(!/^(\x01(Via|Recd|Forwarded))(:|\s)/,@lines)))); 548 } 549 $key = sprintf("NETMAIL|%s|%s|%08x", $msgid, $toaddr, crc32($fromname . $toname . $subject)); 550 $path = $lastpath = ""; 551 foreach(grep(/^\x01(Via|Recd|Forwarded):?\s/, @lines)) 552 { next unless m#(\d+:\d+/\d+(?:\.\d+)?)(\@|\s)#; 553 next if $lastpath eq $1; 554 $lastpath = $1; 555 $path .= " " if $path; 556 $path .= $1; 557 } 558 $curtime = time(); 559 if ($oldval=checkdupe($key)) 560 { # Dupe or Loop 561 $dupetext = $text; 562 $dupetext =~ s/\r\n?/\n/gs; 563 ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $oldval); 564 $oldtime = localtime($oldtime); 565 if ($path eq $oldpath && $oldpktfrom eq $pktfrom) 566 { # Dupe 567 $dupetext = <<EOF; 568Pkt from: $pktfrom 569Original msg arrived: $oldtime 570$dupetext 571EOF 572 putMsgInArea("NETMAILDUPES", $fromname, $toname, $fromaddr, "", 573 $subject, $date, "pvt sent read", $dupetext, 0); 574 $kill = 1; 575 return "Dupe"; 576 } else 577 { # Loop 578 putMsgInArea("LOOPS", $fromname, $toname, $fromaddr, $toaddr, 579 $subject, $date, "pvt sent read", 580 "hpt> loop\r" . $text, 0); 581 $kill = 1; 582 return "Loop"; 583 } 584 } 585 adddupe($key, "$curtime|$path|$pktfrom"); 586 } 587 if (_route($toaddr, $attr, $text) eq $pktfrom) 588 { # Route to pktfrom-addr -- ping-pong 589 putMsgInArea("LOOPS", $fromname, $toname, $fromaddr, $toaddr, 590 $subject, $date, "pvt sent read", 591 "hpt> ping-pong with $pktfrom\r" . $text, 0); 592 $kill = 1; 593 return "Loop"; 594 } 595 if (isattr("arq", $attr)) 596 { arqcpt($fromaddr, $toaddr, $fromname, $toname, $subject, $date, $attr, $text); 597 } 598 } 599 $newnet = 1; 600 return ""; 601} 602 603sub scan 604{ 605# predefined variables: 606# $area, $fromname, $fromaddr, $toname, 607# $toaddr (for netmail), 608# $subject, $text, $date, $attr 609# return "" or reason for dont packing to downlinks 610# set $change to update $text, $subject, $fromaddr, $toaddr, $fromname, $toname 611 my ($toboss, $addr, $msgid, $key); 612 my ($oldtime, $oldpath, $oldpktfrom, $dupetext); 613 614 if ($toaddr eq "") 615 { # echomail 616 unless ($msgtied) 617 { 618 tie(%msg, 'DB_File', msgdb, O_RDWR|O_CREAT, 0644) || return ""; 619 $msgtied = 1; 620 } 621 ($msgid) = grep(/^\x01MSGID:/, split('\r', $text)); 622 if ($msgid) 623 { $msgid =~ s/^\x01MSGID:\s*//; 624 $msgid =~ tr/A-Z/a-z/; 625 } 626 else 627 { $msgid = sprintf("C%s %08x", $fromaddr, crc32($date . join(' ',grep(!/^(\x01PATH|SEEN-BY):/,split('\r', $text))))); 628 } 629 $key = "$area|$msgid|" . crc32($fromname . $toname . $subject); 630 if (defined($msg{$key})) 631 { # Dupe 632 ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $msg{$key}); 633 $dupetext = <<EOF; 634Pkt from: local 635Original pkt from: $oldpktfrom 636Original PATH: $oldpath 637$text 638EOF 639 putMsgInArea("DUPES", $fromname, $toname, $fromaddr, "", 640 $subject, $date, "pvt sent read", $dupetext, 0); 641 return "Dupe"; 642 } 643 $msg{$key} = time() . "|local|local"; 644 return ""; 645 } 646 $toboss = $toaddr; 647 $toboss =~ s/\.\d+$//; 648 # Remove my "hpt> " comments 649 if ($text =~ /^((?:\x01[^\r]+\r)*)hpt> [^\r]+\r/) 650 { $text = "$1$'"; 651 $change = 1; 652 } 653 compileNL() unless $nltied; 654 if ($nltied && !defined($nodelist{$toboss})) 655 { 656 bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, 657 "Node $toboss mising in $curnodelist"); 658 return "Node $toboss mising in $curnodelist"; 659 } 660 if ($fromaddr eq $myaddr[0] && 661 !isattr("cpt", $attr) && 662 $area =~ /^netmail$/i && 663 $fromname !~ /areafix|crazy mail robot|allfix|ping|uucp/i) 664 { putMsgInArea("I_SENT", $fromname, $toname, $fromaddr, $toaddr, 665 $subject, $date, "pvt sent read", $text, 0); 666 } 667 if ($toaddr eq $myaddr[0]) 668 { if ($toname =~ /^faqserver$/i) 669 { 670 faqserv($fromaddr, $fromname, $subject, $text); 671 $newnet = 1; 672 return "Message to FaqServer"; 673 } 674 unless ($toname =~ /^(areafix|allfix|filefix)$/i) 675 { putMsgInArea("GUL", $fromname, $toname, $fromaddr, $toaddr, 676 $subject, $date, "pvt sent read", $text, 0); 677 return "Message to gul"; 678 } 679 } 680 $addr = $area; 681 $addr =~ tr/A-Z/a-z/; 682 foreach(maillists) 683 { s/ //g; 684 tr/A-Z/a-z/; 685 if ($addr eq $_) 686 { $toaddr = "2:46/128"; 687 $toname = "$_\@lucky.net"; 688 $text =~ s#^((?:.*\r)?)\x01INTL\s+\S+\s+(\S+)\s*\r#$1\x01INTL 2:46/128 $2\r#s; 689 $text =~ s/^((?:.*\r)?)\x01TOPT[^\r]+\r//s; 690 $change = 1; 691 return ""; 692 } 693 } 694 return ""; 695} 696 697sub route 698{ 699# $addr = dest addr 700# $from = orig addr 701# $text = message text 702# $attr = message attributes 703# set $flavour to hold|normal|crash|direct|immediate 704# return route addr or "" for default routing 705 706 return _route($toaddr, $attr, $text); 707} 708 709sub _route 710{ 711 my ($toaddr, $attr, $text) = @_; 712 713 my @routemail = ( 714"crash 17:1800/94 17:.*", 715"hold 2:46/128 (2:46/128|2:463/68.128)", 716"hold 2:999/999 2:46/128\.", 717"hold noroute 2:463/68(\.\d+)?", 718"hold 2:463/68.8 2:463/8\.2", 719"hold 2:463/68.17 2:463/62\.17", 720"crash 2:463/168 2:463/168(\.\d+)?", 721"normal 2:463/666 2:(463/666|46/200)(\.\d+)?", 722"crash 2:463/94 [123456]:.*", 723"hold 2:999/999 .*" 724); 725 my @routefile = ( 726"crash 2:463/94 2:(463/83|463/940(\.\d+)?|462/95|4653/10|4643/5", 727"crash 2:463/94 2:463/11(\.11)?", 728"normal 2:463/666 2:(463/666(\.\d+)?|2:46/200)", 729"crash 2:463/94 2:(46/0|465/50|465/70)", 730"hold noroute .*" 731); 732 my (@route, $dest, $patt, $boss, $host, $flags); 733 734 compileNL() unless $nltied; 735 736 if (isattr("att", $attr)) 737 { @route = @routefile; 738 } else 739 { @route = @routemail; 740 } 741 $addr =~ s/\.0$//; 742 743 $flags = $1 if $text =~ /^(.*\r\n?)?\x01FLAGS\s+(\S[^\r]*\S)\s*\r/; 744 $flags =~ tr/A-Z/a-z/; 745 foreach $flavour ("hld", "dir", "crash", "imm") 746 { if (str2attr($flavour) != -1) 747 { if ($attr & str2attr($flavour)) 748 { 749 $flavour = "hold" if $flavour eq "hld"; 750 return $addr; 751 } 752 } else 753 { 754 if (index($flags, $flavour) >= 0) 755 { 756 $flavour = "immediate" if $flavour = "imm"; 757 return $addr; 758 } 759 } 760 } 761 762 foreach (@route) 763 { ($flavour, $dest, $patt) = split(/\s+/, $_); 764 $boss = $addr; 765 $boss =~ s/\..*//; 766 $host = $boss; 767 $host =~ s#/.*#/0#; 768 if ($patt =~ /^hub(.*)/i) 769 { $_ = $1; 770 if ($nodelist{$boss} =~ /,(.*)/) 771 { $patt = ".*" if $_ eq $1; 772 } 773 } elsif ($patt =~ /^reg(.*)/i) 774 { $_ = $1; 775 if ($nodelist{$host} =~ /^(.*),/) 776 { $patt = ".*" if $_ eq $1; 777 } 778 } 779 if ($addr =~ /^$patt$/) 780 { if ($dest eq "noroute") 781 { $dest = $addr; 782 } elsif ($dest eq "boss") 783 { $dest = $boss; 784 } elsif ($dest eq "host") 785 { $dest = $host; 786 } elsif ($dest eq "hub") 787 { $dest = $boss; 788 if ($nodelist{$boss} =~ /,(.*)/) 789 { $dest = $1; 790 } else 791 { $dest = $host; 792 } 793 } 794 return $dest; 795 } 796 } 797 return ""; 798} 799 800sub hpt_exit 801{ 802 my($flags); 803 local(*F); 804 untie %nodelist if $nltied; 805 untie %pkt if $pkttied; 806 untie %msg if $msgtied; 807 if (@areas) 808 { putlist(); 809 @areas = (); 810 } 811 $nltied = $pkttied = $msgtied = 0; 812 $flags = $ENV{"FLAGS"}; 813 close(F) if $newnet && open(F, ">$flags/wasnet.now"); 814 close(F) if $newecho && open(F, ">$flags/wasecho.now"); 815} 816 817sub process_pkt 818{ 819# $pktname - name of pkt 820# $secure - defined for secure pkt 821# return non-empty string for rejecting pkt (don't process, rename to *.dup) 822 my($crc, $a, $mtime, $size, $pktstart); 823 local(*F); 824 $processpktname = ""; 825 %msgpkt = (); 826 unless ($pkttied) 827 { 828 if (tie(%pkt, 'DB_File', pktdb, O_RDWR|O_CREAT, 0644)) 829 { $pkttied = 1; 830 } else 831 { return ""; 832 } 833 } 834 ($size,$mtime) = (stat($pktname))[7,9]; 835 open(F, "<$pktname") || return; 836 read(F, $pktstart, 58+178); # sizeof(pkthdr) + sizeof(msghdr) (max msghdr) 837 close(F); 838 $crc = crc32($pktstart); 839 $pktname =~ s/^.*[\/\\]//; # basename 840 $pktname =~ tr/A-Z/a-z/; 841 $pktkey = sprintf("%s|%u|%08x|%08x", $pktname, $size, $mtime, $crc); 842 $pktval = time(); 843 $processpktname = $pktname; 844 return "Duplicate $pktname" if defined($pkt{$pktkey}); 845 return ""; 846} 847 848sub pkt_done 849{ 850# $pktname - name of pkt 851# $rc - exit code (0 - OK) 852# $res - reason (text line) 853# 0 - OK ($res undefined) 854# 1 - Security violation 855# 2 - Can't open pkt 856# 3 - Bad pkt format 857# 4 - Not to us 858# 5 - Msg tossing problem 859 my ($key, $val, $curtime, $sec, $min, $hour, $mday, $msgtime); 860 return if defined($res) || !defined($pktkey) || !$pkttied; 861 $pktname =~ s/^.*[\/\\]//; # basename 862 $pktname =~ tr/A-Z/a-z/; 863 return if $pktname ne $processpktname && $pktname ne ""; 864 $pkt{$pktkey} = $pktval; 865 ($sec,$min,$hour,$mday) = localtime(); 866 if ($mday ne $pkt{"lastpurge"}) 867 { print "Purging pkt dupebase..."; 868 $curtime = time(); 869 while (($key, $val) = each %pkt) 870 { delete($pkt{$key}) if $curtime-$val>14*24*3600; 871 } 872 $pkt{"lastpurge"} = $mday; 873 print " Done\n"; 874 } 875 $processpktname = ""; 876 return if !$msgtied; 877 while (($key, $val) = each %msgpkt) 878 { $msg{$key} = $val; 879 delete $msgpkt{$key}; 880 } 881 %msgpkt = (); 882 if ($mday ne $msg{"lastpurge"}) 883 { print "Purging msg dupebase..."; 884 $curtime = time(); 885 while (($key, $val) = each %msg) 886 { ($msgtime) = split(/\|/, $val); 887 delete($msg{$key}) if $curtime-$msgtime>14*24*3600; 888 } 889 $msg{"lastpurge"} = $mday; 890 print " Done\n"; 891 } 892} 893 894sub after_unpack 895{ 896} 897 898sub before_pack 899{ 900} 901 902 903# ======================================================================== 904# local functions 905# ======================================================================== 906 907sub compileNL 908{ 909 my(@nlfiles, $a, $mtime, $ctime, $curtime, $curmtime, $curctime); 910 my($zone, $region, $net, $hub, $node, $flag); 911 local(*F); 912 opendir(F, nodelistDir()) || return; 913 @nlfiles = grep(/^nodelist\.\d\d\d$/i, readdir(F)); 914 closedir(F); 915 return unless @nlfiles; 916 $curnodelist = pop(@nlfiles); 917 ($curmtime,$curctime) = (stat(nodelistDir . "/$curnodelist"))[9,10]; 918 foreach(@nlfiles) 919 { ($mtime,$ctime) = (stat(nodelistDir . "/$_"))[9,10]; 920 if ($mtime > $curmtime) 921 { $curmtime = $mtime; 922 $curctime = $ctime; 923 $curnodelist = $_; 924 } 925 } 926 ($mtime,$ctime) = (stat($nldb))[9,10]; 927 if (!defined($mtime) || $mtime < $curmtime) 928 { 929 unlink(nldb); 930 tie(%nodelist, 'DB_File', nldb, O_RDWR|O_CREAT, 0644) || return; 931 unless (open(F, "<".nodelistDir()."/$curnodelist")) 932 { untie(%nodelist); 933 return; 934 } 935 $zone = $region = $net = $hub = ""; 936 print "Compiling nodelist..."; 937 while (<F>) 938 { chomp(); 939 next if /^(;.*)?$/; 940 ($flag,$node) = split(/,/); 941 if ($flag eq "Zone") 942 { $zone = $net = $node; 943 $node = 0; 944 $region = $hub = "$zone:$net/$node"; 945 } elsif ($flag eq "Region") 946 { $net = $node; 947 $node = 0; 948 $region = $hub = "$zone:$net/$node"; 949 } elsif ($flag eq "Host") 950 { $net = $node; 951 $node = 0; 952 $hub = "$zone:$net/$node"; 953 } elsif ($flag eq "Hub") 954 { $hub = "$zone:$net/$node"; 955 } 956 $nodelist{"$zone:$net/$node"}="$region,$hub"; 957 } 958 close(F); 959 untie(%nodelist); 960 print "Done.\n"; 961 } 962 tie(%nodelist, 'DB_File', nldb, O_RDONLY) && ($nltied=1); 963 return; 964} 965 966sub bounce 967{ 968 my($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, $reason) = @_; 969 my($bouncetext); 970 local(*F); 971 972 $text =~ tr/\r/\n/; 973 $text =~ s/\n\x01/\n\@/gs; 974 $text =~ s/^\x01/\@/s; 975 $bouncetext = <<EOF; 976 Hello $fromname. 977 978$reason 979Therefore I must return this message to you. 980 981 Lucky Carrier, 982 Pavel Gulchouck 983 gul\@gul.kiev.ua 984 985Orignal message: 986 987============================================================================ 988FROM: $fromname $fromaddr 989TO : $toname $toaddr 990SUBJ: $subject 991DATE: $date 992============================================================================ 993$text 994============================================================================ 995EOF 996 putMsgInArea("", "Crazy Mail Robot", $fromname, "", $toaddr, 997 "Unable to delivery", "", "pvt k/s loc cpt", $bouncetext, 1); 998 $newnet = 1; 999 return $reason; 1000} 1001 1002sub isattr 1003{ 1004 my($sattr, $attr) = @_; 1005 return $attr & str2attr($sattr); 1006} 1007 1008sub faqserv 1009{ 1010 my($fromaddr, $fromname, $subject, $text) = @_; 1011 my($size, $fsize, @lines, $reply, $correct, $skip, $topic, $a); 1012 local(*F); 1013 @lines = split('\r', $text); 1014 if ($subject =~ /\S/) 1015 { @lines = unshift(@lines, "Subject: $subject"); 1016 } else 1017 { $subject = ""; 1018 } 1019 $reply = ""; 1020 $skip = ""; 1021 $size = 0; 1022 foreach (@lines) 1023 { 1024 $reply .= "> $_\r"; 1025 next if $skip; 1026 $_ = $subject if $subject; 1027 $subject = ""; 1028 s/^\s*%?(\S+).*/$1/; 1029 s/^(........).*$/$1/; 1030 tr/A-Z/a-z/; 1031 if (/^(--.*|quit|exit)$/) 1032 { $reply .= "Rest skipped\r"; 1033 $skip = 1; 1034 next; 1035 } 1036 $fsize = (stat(faq . "$_.faq"))[7]; 1037 if (($size += $fsize) > 102400) 1038 { $reply .= "Size limit riched, rest skipped\r"; 1039 $skip = 1; 1040 next; 1041 } 1042 if (open(F, "<" . faq . "$_.faq")) 1043 { read(F, $topic, $fsize); 1044 putMsgInArea("", "FaqServer", $fromname, "", $fromaddr, 1045 "Topic $_", "", "pvt loc k/s cpt", "Topic $_", $topic, 1); 1046 close(F); 1047 $correct = 1; 1048 } 1049 else 1050 { 1051 $reply .= "Topic $_ not found\r"; 1052 } 1053 } 1054 unless($correct) 1055 { 1056 $reply .= "No valid commands found, help sent\r"; 1057 if (open(F, "<" . faq . "help.faq")) 1058 { read(F, $topic, $fsize); 1059 putMsgInArea("", "FaqServer", $fromname, "", $fromaddr, 1060 "Help response", "", "pvt loc k/s cpt", $topic, 1); 1061 close(F); 1062 } 1063 } 1064 putMsgInArea("", "FaqServer", $fromname, "", $fromaddr, 1065 "FaqServer reply", "", "pvt loc k/s cpt", $reply, 1); 1066} 1067 1068sub putlist 1069{ 1070 my(%areas, $fromaddr, $areaname, $desc); 1071 local(*F); 1072 1073 %areas = (); 1074 $fromaddr = shift(@areas); 1075 while(@areas) 1076 { 1077 $_ = shift(@areas); 1078 next unless /^(\S+)(?:\s+(\S.*)|\s*)$/; 1079 ($areaname, $desc) = ($1, $2); 1080 $desc = "" if $desc =~ /autocreated|new\/unsorted|description missing/i; 1081 $desc = "" if $desc =~ /^(Regional|Gated) [Ee]choe?s$/; 1082 if (defined($areas{$areaname})) 1083 { next if $desc eq ""; 1084 $areas{$areaname} = $desc; 1085 } 1086 else 1087 { $areas{$areaname} = $desc; 1088 } 1089 } 1090 return if listname($fromaddr) eq ""; 1091 open(F, ">".listdir().listname($fromaddr)) || return; 1092 foreach (sort keys %areas) 1093 { print F "$_ " . $areas{$_} . "\n"; 1094 } 1095 close(F); 1096 return; 1097} 1098 1099sub arqcpt 1100{ 1101 my($fromaddr, $toaddr, $fromname, $toname, $subject, $date, $attr, $origtext) = @_; 1102 my($text, $route); 1103 $route = _route($toaddr, $attr, $origtext); 1104 $route = "internet gate" if $route eq "2:46/128"; 1105 $text = <<EOF; 1106 Hello $fromname! 1107 1108Your message with ARQ passed to $route through my station. 1109 1110Original message header: 1111============================================================= 1112 From: $fromname $fromaddr 1113 To: $toname $toaddr 1114 Subject: $subject 1115 Date: $date 1116============================================================= 1117 1118 Lucky carrier, 1119 Pavel Gulchouck (and my mail robot;) 1120EOF 1121 putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr, 1122 "Audit Receipt Response", "", "pvt k/s loc cpt", $text, 1); 1123 $newnet = 1; 1124} 1125 1126sub receipt 1127{ 1128 my($fromaddr, $toaddr, $fromname, $toname, $subject, $date) = @_; 1129 my($text); 1130 $text = <<EOF; 1131 Hello $fromname! 1132 1133Your message to $toname successfully delivered. 1134 1135Original message header: 1136============================================================= 1137 From: $fromname $fromaddr 1138 To: $toname $toaddr 1139 Subject: $subject 1140 Date: $date 1141============================================================= 1142 1143 Lucky carrier, 1144 Pavel Gulchouck (and my mail robot;) 1145EOF 1146 putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr, 1147 "Return Receipt Response", "", "pvt k/s loc cpt", $text, 1); 1148 $newnet = 1; 1149} 1150