#!/usr//bin/perl $DEFAULT_URL_FILE = "multi.txt"; $real = $ENV{'QUERY_STRING'}; @querysplit = split(/\?/,$real); $daurl = lc($querysplit[0]) . ".txt"; if (-e "data/$daurl") { $DEFAULT_URL_FILE = "data/$daurl"; } $|=1; $PATH_SEPARATOR = "/"; $FULL_PATH_PATTERN = "^/"; $ALLOWED_URL_PATTERN = "^http://|^ftp://|^gopher://"; $ALLOWED_PATH_PATTERN = ".*.txt\$"; $LISTFILE_BASE = ""; eval("&main"); if ($@) { &report_error($@); } sub main { local(%input); &read_cgi_input(*input); srand(); local(@urls) = &read_url_file($input{"file"} || $DEFAULT_URL_FILE); &perform_redirect(&random_pick_from_list(@urls)); } sub report_error { local($error) = @_; print <<"EndOfHTML"; Content-type: text/html URL Error

Random URL Error

No URL could be returned because the error:

$error

occurred. Sorry.

EndOfHTML } sub read_url_file { local($filename) = @_; local($pathname,@path,@urls); SWITCH: { $pathname = $filename, last SWITCH if (m|$FULL_PATH_PATTERN|); $pathname = $LISTFILE_BASE . $filename, last SWITCH if ($LISTFILE_BASE); @path = split($PATH_SEPARATOR,$0); pop(@path); push(@path,$filename); $pathname = join($PATH_SEPARATOR,@path); } die "this script isn't allowed to read '$pathname'" unless ($pathname =~ $ALLOWED_PATH_PATTERN); open(FILE,$pathname) || die "can't open list file '$pathname': $!"; while() { chop; push(@urls,$_) if !/(^\s*$|^\s*#)/; } close(FILE); return @urls; } sub random_pick_from_list { @TheMonths=("","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); local(@list) = @_; ($Second,$Minute,$Hour,$DayOfMonth,$Month,$Year,$WeekDay,$DayOfYear,$IsDST)=localtime(time); $RealMonth=$Month+1; $Year=substr($Year,1,2); if (($DayOfMonth+1) >= 28) {$DayOfMonth="01";$RealMonth++;} else {$DayOfMonth++;} if ($DayOfMonth <= 9) {$DayOfMonth="0".$DayOfMonth} $expDate = "$Year-$TheMonths[$RealMonth]-$DayOfMonth 00:00:00 GMT"; $domain = ".realtgp.com"; $path = "/cgi-bin/"; %cookies = &getCookies; if($cookies{tloop} > $#list){$cookies{tloop} = 0;} &setCookie("tloop", $cookies{tloop}+1, $expDate, $path, $domain); if ($cookies{tloop} ne "") { return $list[$cookies{tloop}] } else { return $list[int(rand(scalar(@list)))]; } } sub perform_redirect { local($url) = @_; die "the line read from the file was not a valid URL" unless ($url =~ $ALLOWED_URL_PATTERN); print <<"EndOfHTML"; Content-type: text/html Location: $url Redirection Failed

Redirection Failed

$url

It appears that your browser cannot handle redirections automatically.
You can proceed to the selected page by
CLICKING HERE

EndOfHTML } sub read_cgi_input { local(*data) = @_; local($buffer); if ($ENV{"REQUEST_METHOD"} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } elsif ($ENV{"REQUEST_METHOD"} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $data{$name} = $value; } } sub setCookie { local($name, $value, $expiration, $path, $domain, $secure) = @_; print "Set-Cookie: "; print ($name, "=", $value, "; expires=", $expiration, "; path=", $path, "; domain=", $domain, "; ", $secure, "\n"); } sub getCookies { local(@rawCookies) = split (/; /,$ENV{'HTTP_COOKIE'}); local(%cookies); foreach(@rawCookies){ ($key, $val) = split (/=/,$_); $cookies{$key} = $val; } return %cookies; }