#!/bin/perl $dir="/export/home/bob/data/gothbase"; if($ENV{'PATH_INFO'}) { $ENV{'QUERY_STRING'}=~tr/A-Z/a-z/; @look=&desafe($ENV{'QUERY_STRING'}); $bestfile=0; if($ENV{'PATH_INFO'} eq '/name') { while($file=<$dir/*>){ if($file=~/\.(html|css)$/i) {next} open(GB,$file); while(){ if(s/^\s*(Net|Real)? ?name:\s*//i){ tr/A-Z/a-z/; foreach(split(/\s*,\s*/)){ $count=&namecount($_,@look); if($count>$bestfile){$bestfile=$count;$best=$file;} } } } close(BG); } } elsif($ENV{'PATH_INFO'} eq '/realname') { while($file=<$dir/*>){ if($file=~/\.(html|css)$/i) {next} open(GB,$file); while(){ if(s/^\s*Real ?name:\s*//i){ tr/A-Z/a-z/; $count=&namecount($_,@look); if($count>$bestfile){$bestfile=$count;$best=$file;} } } close(BG); } } elsif($ENV{'PATH_INFO'} eq '/netname') { while($file=<$dir/*>){ if($file=~/\.(html|css)$/i) {next} open(GB,$file); while(){ if(s/^\s*(Net)?name:\s*//i){ tr/A-Z/a-z/; foreach(split(/\s*,\s*/)){ $count=&namecount($_,@look); if($count>$bestfile){$bestfile=$count;$best=$file;} } } } close(BG); } } elsif($ENV{'PATH_INFO'} eq '/email') { $look=join('',@look); while($file=<$dir/*>){ if($file=~/\.(html|css)$/i) {next} open(GB,$file); while(){ chop; if(s/^\s*E-?mail:\s*//i){ tr/A-Z/a-z/; foreach(split(/\s*,\s*/)){ $count=&emailcount($_,$look); if($count>$bestfile){$bestfile=$count;$best=$file;} } } } close(BG); } } else {&fail()} if($bestfile==0){&fail("$ENV{'QUERY_STRING'} not found in database","404 Not found")} print "Content-type: text/html\n\n"; open(FILE,"<$best"); &parse(); close(FILE); exit; } elsif($ENV{'QUERY_STRING'}=~/\//){&fail()} elsif(-f "$dir/$ENV{'QUERY_STRING'}") { @perm=stat("$dir/$ENV{'QUERY_STRING'}"); if(!($perm[2] & 4)){&fail("File does not exist","404 Not found")} print "Content-type: text/html\n\n"; open(FILE,"<$dir/$ENV{'QUERY_STRING'}"); &parse(); close(FILE); exit; } else { print "Content-type: text/html\n\n"; print "Gothbase\n", '',"\n", "

net.goth Database

){ chop; s/&/&/g; s/>/>/g; s/"; $nom=$net||$real||"none"; $nom=~s/$.*$//; print "$nom"; if($email){$email=~s/[, \/].*$//;&protect($email);print " <$email>\n"} } print "

\n"; } sub protect { $_[0]=~tr/n-za-mN-ZA-M@0-45-9/a-mn-zA-MN-Z+5-90-4/; } sub parse{ $name=$ENV{'QUERY_STRING'}; print "\n\n"; $text="<table>"; foreach(@_){ $c=""; if(/^- (Version.*)-/){ $name=~s/,.*$//; print "Gothbase entry for $name\n\n

$name

$text\n

$1\n"; last; } if(s/^ ?(\S[^:]*)://){ $a=$1;$a=~tr/_/ /; if($a=~/e-?mail|address|phone/i) {$c=' class="prot"';&protect($_);} $text.="\n$a$_"; if($a eq 'Netname' && $_ ne ""){$name=$_} if($name eq "" && $a eq 'Realname' && $_ ne ""){$name=$_} } else {$text.=$_} } } sub fail { print "Content-type: text/html\n"; if ($_[1] ne "") { print "Status: $_[1]\n\n"; } else { print "Status: 400 Bad request\n\n"; } print "Error!\n"; print "

Error

$_[0]

\n"; print "\n"; exit; } sub desafe { @all=(); @lines=split(/[?+]/,$_[0]); foreach(@lines){ @line=split(/[%]/); $text=shift(@line); foreach(@line){ $text=$text.pack("C",hex(substr($_,0,2))); } @all=(@all,split(/ /,$text)); } @all; } sub namecount { local($word,@look)=@_; if($word=~/^\s*$/){return 0} local(@words)=split(/\s+/,$word); $c=$ws=0; if($#words==$#look){return ($words[0] eq $look[0])} for($j=0;$j<=$#look;$j++){ for($i=$ws;$i<=$#words;$i++){ if($look[$j] eq $words[$i]){ $c++; $ws=$i+1; } } } return $c; } sub emailcount { local($word,$look)=@_; if($word=~/^\s*$/){return 0} $look=~s/@(.*)$//; local(@lhost)=split(/\./,$1); $word=~s/@(.*)$//; local(@whost)=split(/\./,$1); if($look ne $word){return 0} $c=1; for($i=0;i<=$#whost;$i++){ if($lhost[$#lhost-$i] eq $whost[$#whost-$i]){$c++} else{last}} return $c; }