#!/usr/bin/perl # File: ark-lib.pl -*- Perl -*- # Created by: Alex (wtwf.com) Fri Nov 10 17:35:37 1995 # Last Modified: Time-stamp: # Alex's perl library of html/www useful stuff # DO NOT EDIT THIS FILE UNLESS YOU ARE CALLED ALEX AND FROM MANCHESTER # Send change requests to wtwf.com - your changes WILL BE LOST sub ARKlib_version { return '$Id: ark-lib.pl,v 1.5 2006/04/13 16:31:54 ark Exp $ '; } # gets the title of a file! sub ARKgettitle { local( $file)=@_; local( $text ); return "" if (-l $file) || !open(ORIGINAL, "<$file"); $text=""; while( ){ $text .= $_; last if /<\/title>/i; } if( $text =~ /(.+)<\/title>/i ){ return $1; } return ""; } sub ARKip_to_addr { local( $addr ) =@_; return "" if( !defined( $addr ) ); if ($addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){ return gethostbyaddr(pack("C4", $1, $2, $3, $4), &AF_INET); } return $addr; } sub ARKprint_header { print "Content-type: text/html\n\n"; # print "Content-type: text/x-server-parsed-html \n\n"; } sub ARKprint_title { local ($title)=@_; print &ARKtitle( $title ); } sub ARKtitle { local($title)=@_; local($timenow); $timenow=`date`; return "<HTML><HEAD>\n<TITLE>$title\n\n" . "\n" . "

Last Created: $timenow

\n" . "

$title

\n"; } sub ARKprint_title_smart { local ($title)=@_; local( $fn ) = &ARKurl2file( &ARKjoinURL( $ENV{'HTTP_REFERER'}, ".body.shtml")); # look back two dirs if file not found $fn =~ s!/[^/]+?(/[^/]+)$!$1! if( !-r $fn ); $fn =~ s!/[^/]+?(/[^/]+)$!$1! if( !-r $fn ); if( -r $fn ){ print "$title\n"; &ARKinclude_fileSSI( $fn ); } else { &ARKprint_title( $title ); } } sub ARKprint_sig { print &ARKsig(); } sub ARKprint_sig_smart { local( $fn ) = &ARKurl2file( &ARKjoinURL( $ENV{'HTTP_REFERER'}, ".sig.shtml")); # look back two dirs if file not found $fn =~ s!/[^/]+?(/[^/]+)$!$1! if( !-r $fn ); $fn =~ s!/[^/]+?(/[^/]+)$!$1! if( !-r $fn ); if( -r $fn ){ &ARKinclude_fileSSI( $fn ); } else { &ARKprint_sig(); } } sub ARKcreated { local( $user, $ip, $mach, $ans ); $user=$ENV{'REMOTE_IDENT'}; $user='someone' if $user !~ /\S+/; $ip=$ENV{'REMOTE_ADDR'}; $mach=&ARKip_to_addr($ip); return "

This page was specially created for $user on $mach ($ip)

"; } sub ARKprint_created { print &ARKcreated(); } sub ARKback { local( $ref ); $ref=$ENV{'HTTP_REFERER'}; if(defined($ref) && $ref =~ /\S+/ ){ return "

You can go Back if you don't know how to use the Back button on your browser.

\n"; } return ""; } sub ARKprint_back { print &ARKback(); } sub ARKsig { return "\n"; } sub ARKprint_end { # Close the document cleanly. print &ARKend(); } sub ARKend { return "\n"; } sub ARKopen_connection { local($bigurl) = shift if @_; local($contype) = @_ ? shift : "GET"; local($version) = @_ ? shift : "HTTP/1.0"; local( $server, $url, $them, $port, $AF, $sockaddr, $aliases, $proto, $type, $len, $thisaddr, $this, $that); ($dummy, $dummy, $server, $url) = split(/\//, $bigurl, 4); ($them,$port) = split(/:/, $server); $port = 80 unless $port; $them = 'localhost' unless $them; $_=$url; $AF=&AF_INET; $sockaddr = 'S n a4 x8'; chop($hostname = `hostname`); ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;; ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); ($name,$aliases,$type,$len,$thataddr) = gethostbyname($them); if( !($thisaddr || $port || $thataddr ) ){ print "ERROR: Could not lookup addresses\n"; return 0; } $this = pack($sockaddr, $AF, 0, $thisaddr); $that = pack($sockaddr, $AF, $port, $thataddr); print "About to open $name $port\n" if $debug; if(!((socket(URL_STREAM, $AF, &SOCK_STREAM, $proto)) && #Make socket filehandle (bind(URL_STREAM, $this)) && # Give the socket an address. (connect(URL_STREAM,$that)) )){ # Call up the server. # there was a problem print join( "ERROR: ", $!) ; return 0; } else { print "Opened o.k. $name\n" if $debug; # Set socket to be command buffered. select(URL_STREAM); $| = 1; select(STDOUT); print "Sending: $contype /$url $version\n" if $debug; print URL_STREAM "$contype /$url $version\n"; if( $version ){ print "Sending: Host: $them\n" if $debug; print URL_STREAM "Host: $them\n"; } print URL_STREAM "\n"; return 1; } } # joins together two URLS to make one url # e.g. http://www/ + fish.html = http://www/fish.html # e.g. http://www/index.html + fish.html = http://www/fish.html # e.g. http://www/s/index.html + /fish.html = http://www/fish.html # e.g. http://www/s/ + /fish.html = http://www/fish.html sub ARKjoinURL { local($base,$url)=@_; # if url has a double // in it then it is fine thank you! return $url if( !$base || $url =~ /\/\// ); # strip down base url to make sure that it doesn't have a .html at the end $base=~s/[^\/]*$//; if( $url =~ /^\// ){ # strip off leading directories $base =~ s/(\/\/[^\/]*)\/.*$/$1/; } return ($base . $url); } sub ARKrelocate { local($url)=@_; print "Location: $url\n\n"; } # returns a new filename based on the one given to it # tries to preserve extension sub ARKuniq_filename { local($file)=@_; local($i,$num); # we can just save it like we want return $file unless -e $file; $i=0; # pah that file exists let's try a new one... while( -e $file && $i < 5 ){ srand( time ^ ($$ + ($$<<15)) ); $num=int(rand( 100 )); # preserve the extension on the file cos I'm nice :-) if( $file =~ /\.\w+$/ ){ $file =~ s/(\.\w+)$/$num$1/; } else { $file .= $num; } $i++; } # bugger! after 5 attempts it still doens't work :-( give up now! $file="" if( -e $file ); return $file; } # this prints out an error page, but has some options all with deafualts # parameter - description - deafults to # $error - the error string - There was an undefined error # $wantheader - do you want Content-type... - YES # $fatal - is this a user or a alex err - YES # $doexit - do you want me to exit - YES sub ARKerror { local($error,$wantheader,$fatal,$doexit)=@_; local($basename); select(STDOUT); $error =$error || "There was an undefined Error!"; $wantheader=1 unless defined($wantheader); $fatal =1 unless defined($fatal); $doexit =1 unless defined($doexit); &ARKprint_header() if( $wantheader ); $basename=$0; $basename=~s/^.*\/(\S+)$/$1/; &ARKprint_title("Error in $basename" ); print "

$error

\n"; if( $fatal ){ print "

Mail alex\@ed.ac.uk\n" . "and tell him his script sucked!

\n"; # I should put some code in here to mail me! } &ARKprint_sig(); &ARKprint_end(); exit if( $doexit ); } # cheecks for a dodgy filename and if it finds one either errors or returns # $file - the filename to check - # $wanterror - do you want me to print an error- YES # $wantheader - print content-type? - YES sub ARKdodgy_filename { return 1 if( ! @_ ); local( $file, $wanterror, $wantheader ) = @_; $wanterror="Filename \"$file\" had dodgy things in it." unless defined($wanterror); $wantheader=1 unless defined($wantheader); # check for .. ; * if($file !~ /^[\w\.\/_-]+$/ || # we're allowed alphanumeric dots and slashes $file =~ /\.\.|[;\'\"\`\|\*]/ ){ #" if( $wanterror){ &ARKerror($wanterror,$wantheader); } else { return 1; } } return 0; } sub ARKdodgy_emails { local(@arr)=split(/[\s,]+/,$_[0]); local($thing); return 1 unless @arr; foreach $thing (@arr) { return 1 unless $thing =~ /^[\w\._+-]+\@\w+[\w_-]*\.\w+(\.\w+)*/; } return 0; } # returns a string sayig who the external user is sub ARKstrangers_name { local($user,$mach,)=($ENV{'REMOTE_USER'}, $ENV{'REMOTE_HOST'} || &ARKip_to_addr($ENV{'REMOTE_ADDR'}) || $ENV{'REMOTE_ADDR'} ); $user=$user || "someone"; $mach=$mach || "some machine"; if( defined( %input ) && defined($input{'mailname'}) && defined( $input{$input{'mailname'}}) && $input{$input{'mailname'}} =~ /\S+/ ){ $user=$input{$input{'mailname'}}; } elsif( defined( %input ) && defined($input{'mailfrom'}) && defined( $input{$input{'mailfrom'}}) && $input{$input{'mailfrom'}} =~ /\S+/ ){ $user=$input{$input{'mailfrom'}}; } return "$user on $mach"; } # returns the argument in bytes as a filesize # e.g. 1024 -> 1K 23 -> 23 bytes sub ARKfilesize { local( $size )= @_; local( @units)=('bytes', 'K', 'Meg', 'Gig', 'Terra' ); while(@units){ # print "\n"; return sprintf(int($size*10)==(int($size+0.5)*10) ? "%d %s" : "%.1f %s", $size, shift @units) if( $size < 1000.0 ); $size/=1000.0; shift @units; } return "Way too Big!"; } # includes the contents of a file into my HTML # used to just insert the text, but now I use SSI sub ARKinclude_file { local($file)=@_; # print "\n"; if( open(INCLUDE, "<$file") ){ while( ){ print $_; } close( INCLUDE ); } else { print "\n"; } } # includes the contents of a file into my HTML # used to just insert the text, but now I use SSI sub ARKinclude_fileSSI { local($file)=@_; # print "\n"; local( $txt) =''; if( open(INCLUDE, "<$file") ){ while( ){ $txt.=$_; } close( INCLUDE ); } else { print "\n"; } $txt=~ s///gi; print $txt; } sub ARKurl2file { return 1 if( ! @_ ); local( $file ) = @_; print "\n" if $debug; print "\n" if $debug; if(!$ENV{'SERVER_NAME'} || $ENV{'SERVER_NAME'} =~ /tardis.ed.ac.uk/ || $file =~ /\/~ark\/(.*)/ ){ $file= (getpwnam('ark'))[7] . "/html/$1"; } elsif( $ENV{'SERVER_NAME'} =~ /bungee.jump.com/i || $ENV{'SERVER_NAME'} =~ /bungeezone.com/i ){ $file= (getpwnam('ark'))[7] . "/html/bungee/" . (split(/\//, $file, 4))[3]; } elsif( $ENV{'SERVER_NAME'} =~ /ragemtb.com/i ){ $file= (getpwnam('ark'))[7] . "/html/rage/" . (split(/\//, $file, 4))[3]; } elsif( $ENV{'SERVER_NAME'} =~ /bloodyeck.com/i ){ $file= (getpwnam('ark'))[7] . "/html/" . (split(/\//, $file, 4))[3]; } elsif( $ENV{'SERVER_NAME'} =~ /wtwf.com/i ){ $file= (getpwnam('ark'))[7] . "/html/wtwf/" . (split(/\//, $file, 4))[3]; } else { print "\n"; } print "\n" if $debug; return $file; } 1; #return true