#! /usr/bin/perl -w
#
# Explain to the user that the URL is blocked and by which rule set
#
# By Pål Baltzersen 1999 (pal.baltzersen@ost.eltele.no)
# French texts thanks to Fabrice Prigent (fabrice.prigent@univ-tlse1.fr)
#
# The last version may be found anytime at:
# http://ftp.ost.eltele.no/pub/www/proxy/squidGuard/contrib/
#
# By accepting this notice, you agree to be bound by the following
# agreements:
#
# This software product, squidGuard, is copyrighted (C) 1999 by ElTele
# Øst AS, Oslo, Norway, with all rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License (version 2) as
# published by the Free Software Foundation. It is distributed in the
# hope that it will be useful, but WITHOUT ANY WARRANTY; without even
# the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE. See the GNU General Public License (GPL) for more details.
#
# You should have received a copy of the GNU General Public License
# (GPL) along with this program.
use strict;
use Socket;
#
# GLOBAL VALUES:
#
my ($clientaddr,$clientname,$clientuser,$clientgroup,$targetgroup,$url);
my ($lang,@supported,$image,$redirect,$autoinaddr,$proxy,$proxymaster);
my (%msgconf,%title,%logo,%msg,%tab,%word);
my ($protocol,$address,$port,$path,$refererhost,$referer);
sub msginit();
sub getpreferedlang(@);
sub parsequery($);
sub status($);
sub redirect($);
sub content($);
sub expires($);
sub title($);
sub terminator();
sub msg($$);
sub table($$@);
sub href($);
sub gethostnames($);
sub spliturl($);
sub showhtml($);
sub showimage($$$);
sub showinaddr($$$$$);
#
# CONFIGURABLE OPTIONS:
#
@supported = ("en (English),", "fr (Français),", "no (norsk)", "tr (Türkçe)."); # "en", "fr", "no" etc.
$image = "/forbidden.gif"; # RELATIVE TO DOCUMENT_ROOT
$redirect = "http://10.254.254.254/forbidden.gif"; # "" TO AVOID REDIRECTION
$proxy = "perde.bizimfirma.com.tr"; #
$proxymaster = "webmaster\@bizimfirma.com.tr"; #
$autoinaddr = 2; # 0|1|2;
# 0 TO NOT REDIRECT
# 1 TO AUTORESOLVE & REDIRECT IF UNIQUE
# 2 TO AUTORESOLVE & REDIRECT TO FIRST NAME
#
# CONFIGURABLE MESSAGES:
#
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# !!! NOTE1: ALLWAYS ESCAPE EMBEDDED VARIABLES (I.E. \$var) !!!
# !!! IF YOU DON'T YOU MAY OPEN A SECURITY HOLE !!!
# !!! NOTE2: TRIPLE ESCAPE EMBEDDED `\', `"', `$', `@', `%' and `&' !!!
# !!! (I.E. \\\\, \\\", \\\$, \\\@, \\\&) !!!
# !!! NOTE3: ESCAPE OTHER SPECIAL INLINE CHARACTERS !!!
# !!! (I.E. \;, \') !!!
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#
sub msginit() {
($clientaddr,$clientname,$clientuser,$clientgroup,$targetgroup,$url)
= parsequery($ENV{"QUERY_STRING"});
($protocol,$address,$port,$path) = spliturl($url);
$lang = getpreferedlang(@supported);
$lang = "tr";
%word->{"unknown"}->{"en"} # THE WORD "unknown"
= "unknown"; # --------- "" ---------
%word->{"unknown"}->{"fr"} # "unknown" IN FRENCH
= "inconnu"; # CHANGE TO YOUR LOCALE
%word->{"unknown"}->{"no"} # "unknown" IN NORWEGIAN
= "ukjent"; # CHANGE TO YOUR LOCALE
%word->{"unknown"}->{"tr"} # "unknown" IN Turkish
= "bilinmeyen"; # CHANGE TO YOUR LOCALE
%title->{"default"}->{"en"} # THE DEFAULT TITLE
= [ "403 Forbidden" ]; # --------- "" ---------
%title->{"default"}->{"fr"} # --------- "" ---------
= [ "403 Interdit" ]; # --------- "" ---------
%title->{"default"}->{"no"} # --------- "" ---------
= [ "403 Sperret" ]; # --------- "" ---------
%title->{"default"}->{"tr"} # --------- "" ---------
= [ "403 Yasak" ]; # --------- "" ---------
%msgconf->{"default"} # THE "default" MESSAGE CONFIG
# (USED WHEN NO OTHER MSGS APPLIES):
= [ "msg:H1:default", # SHOW MSG "default" AS <H1> (DEFINED BELOW)
"tab:R,C,L:info" # SHOW "info" AS <TABLE> & COLUMNS ALIGNED R,C,L
. ":clientaddr" # AND WITH THESE ELEMENTS (DEFINED BELOW)
. ":clientname" # --------- "" --------- "" ---------
. ":clientuser" # --------- "" --------- "" ---------
. ":clientgroup" # --------- "" --------- "" ---------
. ":url" # --------- "" --------- "" ---------
. ":targetgroup", # --------- "" --------- "" ---------
"msg:P:proxymaster", # SHOW "proxymaster" AS <P> (DEFINED BELOW)
"msg:P:refresh" # SHOW "refresh" AS <P> (DEFINED BELOW)
];
%msgconf->{"unknown"} # THE "unknown" CLIENT MESSAGE CONFIG:
= [ "msg:H1:unknown", # SHOW "unknown" AS <H1> (DEFINED BELOW)
"tab:R,C,L:info" # SHOW "info" AS <TABLE> & COLUMNS ALIGNED R,C,L
. ":clientaddr" # AND WITH THESE ELEMENTS (DEFINED BELOW)
. ":clientname" # --------- "" --------- "" ---------
. ":clientuser" # --------- "" --------- "" ---------
. ":clientgroup", # --------- "" --------- "" ---------
"msg:P:proxymaster", # SHOW "proxymaster" AS <P> (DEFINED BELOW)
"msg:P:refresh" # SHOW "refresh" AS <P> (DEFINED BELOW)
];
%msgconf->{%word->{"unknown"}->{$lang}}
= %msgconf->{"unknown"};
%msgconf->{"in-addr"} # THE MESSAGE CONFIG FOR THE "in-addr" DEST GROUP:
= [ "msg:H1:alternatives", # SHOW "alternatives" AS <H1> (DEFINED BELOW)
"alternatives", # SHOW THE ALTERNATIV DOMAIN ADDRESSES
"referermaster", # SHOW "referermaster" (DEFINED BELOW)
"msg:P:refresh" # SHOW "refresh" AS <P> (DEFINED BELOW)
];
%msgconf->{"noalternatives"} # DITTO WHEN THERE ARE NO DOMAIN ADDRESS ALTERNATIVES:
= [ "msg:H1:in-addr", # SHOW "in-addr" AS <H1> (DEFINED BELOW)
"tab:R,C,L:info" # SHOW "info" AS <TABLE> & COLUMNS ALIGNED R,C,L
. ":clientaddr" # AND WITH THESE ELEMENTS (DEFINED BELOW)
. ":clientname" # --------- "" --------- "" ---------
. ":clientuser" # --------- "" --------- "" ---------
. ":clientgroup" # --------- "" --------- "" ---------
. ":domainurl" # --------- "" --------- "" ---------
. ":targetgroup", # --------- "" --------- "" ---------
"msg:H3:noalternatives", # SHOW "noalternatives" AS <H3> (DEFINED BELOW)
"msg:P:webmaster", # SHOW "webmaster" AS <P> (DEFINED BELOW)
"msg:P:refresh" # SHOW "refresh" AS <P> (DEFINED BELOW)
];
%msg->{"default"}->{"en"} # THE MSG TEXT "default" IN "en" (ENGLISH):
= [ "Access to this site is blocked" ]; #
%msg->{"default"}->{"fr"} # THE MSG TEXT "default" IN "fr" (FRENCH):
= [ "L\'accès à ce site est bloqué" ]; #
%msg->{"default"}->{"no"} # THE MSG TEXT "default" IN "no" (NORWEGIAN):
= [ "Siden er sperret" ]; #
%msg->{"default"}->{"tr"} # THE MSG TEXT "default" IN "tr" (TURKISH):
= [ "Bu siteye erişim yasaklanmıştır" ]; #
# THE "info" TABLE IN "en" (ENGLISH):
%tab->{"info"}->{"caption"}->{"en"} # THE "info" TABLE'S TITLE:
= [ "Additional information:" ]; #
%tab->{"info"}->{"clientaddr"}->{"en"} # THE "clientaddr" MSG OPTION:
= [ "Client address", "=", "\$clientaddr" ];#
%tab->{"info"}->{"clientname"}->{"en"} # THE "clientname" MSG OPTION:
= [ "Client name", "=", "\$clientname" ]; #
%tab->{"info"}->{"clientuser"}->{"en"} # THE "clientuser" MSG OPTION:
= [ "Client user", "=", "\$clientuser" ]; #
%tab->{"info"}->{"clientgroup"}->{"en"} # THE "clientgroup" MSG OPTION:
= [ "Client group", "=", "\$clientgroup" ]; #
%tab->{"info"}->{"url"}->{"en"} # THE "url" MSG OPTION:
= [ "URL", "=", "\$url" ]; #
%tab->{"info"}->{"domainurl"}->{"en"} # THE "domainurl" MSG OPTION:
= [ "URL", "=", "\$protocol://<U>\$address</U>\$port\$path" ];
%tab->{"info"}->{"targetgroup"}->{"en"} # THE "targetgroup" MSG OPTION:
= [ "Target group", "=", "\$targetgroup" ]; #
%tab->{"info"}->{"caption"}->{"fr"} # DITTO IN "fr" (FRENCH):
= [ "Information complémentaire:" ]; # --------- "" ---------
%tab->{"info"}->{"clientaddr"}->{"fr"} # --------- "" ---------
= [ "Adresse de la machine", "=", "\$clientaddr" ];
%tab->{"info"}->{"clientname"}->{"fr"} # --------- "" ---------
= [ "Nom de la machine", "=", "\$clientname" ];
%tab->{"info"}->{"clientuser"}->{"fr"} # --------- "" ---------
= [ "Utilisateur", "=", "\$clientuser" ]; # --------- "" ---------
%tab->{"info"}->{"clientgroup"}->{"fr"} # --------- "" ---------
= [ "Groupe", "=", "\$clientgroup" ]; # --------- "" ---------
%tab->{"info"}->{"url"}->{"fr"} # --------- "" ---------
= [ "URL", "=", "\$url" ]; # --------- "" ---------
%tab->{"info"}->{"domainurl"}->{"fr"} # --------- "" ---------
= [ "URL", "=", "\$protocol://<U>\$address</U>\$port\$path" ];
%tab->{"info"}->{"targetgroup"}->{"fr"} # --------- "" ---------
= [ "Groupe cible", "=", "\$targetgroup" ]; # --------- "" ---------
%tab->{"info"}->{"caption"}->{"no"} # DITTO IN "no" (NORWEGIAN):
= [ "Tilleggsinformasjon:" ]; # --------- "" ---------
%tab->{"info"}->{"clientaddr"}->{"no"} # --------- "" ---------
= [ "Klientadresse", "=", "\$clientaddr" ]; # --------- "" ---------
%tab->{"info"}->{"clientname"}->{"no"} # --------- "" ---------
= [ "Klientnavn", "=", "\$clientname" ]; # --------- "" ---------
%tab->{"info"}->{"clientuser"}->{"no"} # --------- "" ---------
= [ "Brukerident", "=", "\$clientuser" ]; # --------- "" ---------
%tab->{"info"}->{"clientgroup"}->{"no"} # --------- "" ---------
= [ "Klientgruppe", "=", "\$clientgroup" ]; # --------- "" ---------
%tab->{"info"}->{"url"}->{"no"} # --------- "" ---------
= [ "URL", "=", "\$url" ]; # --------- "" ---------
%tab->{"info"}->{"domainurl"}->{"no"} # --------- "" ---------
= [ "URL", "=", "\$protocol://<U>\$address</U>\$port\$path" ];
%tab->{"info"}->{"targetgroup"}->{"no"} # --------- "" ---------
= [ "Målkategori", "=", "\$targetgroup" ]; # --------- "" ---------
# THE "info" TABLE IN "en" (ENGLISH):
%tab->{"info"}->{"caption"}->{"tr"} # THE "info" TABLE'S TITLE:
= [ "Bilgileriniz:" ]; #
%tab->{"info"}->{"clientaddr"}->{"tr"} # THE "clientaddr" MSG OPTION:
= [ "Sizin IP Adresiniz", "=", "<font face=bold><b>\$clientaddr</b></font>" ];#
%tab->{"info"}->{"clientuser"}->{"tr"} # THE "clientuser" MSG OPTION:
= [ "Kimliğiniz", "=", "<b>\$clientuser</b>" ]; #
%tab->{"info"}->{"clientgroup"}->{"tr"} # THE "clientgroup" MSG OPTION:
= [ "İzin Grubunuz", "=", "<b>\$clientgroup</b>" ]; #
%tab->{"info"}->{"url"}->{"tr"} # THE "url" MSG OPTION:
= [ "Erişmek istediğiniz adres", "=", "<b>\$url</b>" ]; #
%tab->{"info"}->{"domainurl"}->{"tr"} # THE "domainurl" MSG OPTION:
= [ "", "", "" ];
%tab->{"info"}->{"clientname"}->{"tr"} # --------- "" ---------
= [ "", "", "" ]; # --------- "" ---------
%tab->{"info"}->{"targetgroup"}->{"tr"} # --------- "" ---------
= [ "", "", "" ]; # --------- "" ---------
%msg->{"proxymaster"}->{"en"}
= [ "If you think this is an error, send <U>this page</U> to",
"<A HREF=\\\"mailto:\$proxymaster\\\">\$proxymaster</A>" ];
%msg->{"proxymaster"}->{"fr"}
= [ "Si vous pensez qu\'il s\'agit d\'une erreur, envoyez <U>cette page</U> à",
"<A HREF=\\\"mailto:\$proxymaster\\\">\$proxymaster</A>" ];
%msg->{"proxymaster"}->{"no"}
= [ "Om du mener dette er feil, så send <U>denne siden</U> til",
"<A HREF=\\\"mailto:\$proxymaster\\\">\$proxymaster</A>" ];
%msg->{"proxymaster"}->{"tr"}
= [ "Eğer bunun bir hata olduğunu düşünüyorsanız, <BR><U>bu sayfayı</U>",
"<A HREF=\\\"mailto:\$proxymaster\\\">\$proxymaster</A> adresine gönderin." ];
%msg->{"refresh"}->{"en"}
= [ "You may need to use the browser's \<\;Reload\>\; button<BR>",
"or even \<\;Keyboard Shift\>\;+\<\;Browser Reload\>\;<BR>",
"to get rid of this page after an access rule change" ];
%msg->{"refresh"}->{"fr"}
= [ "Vous avez peut-être besoin d\'utiliser le bouton \<\;Recharger\>\;<BR>",
"ou même \<\;Shift\>\;+\<\;Recharger\>\;<BR>",
"après un changement de règles" ];
%msg->{"refresh"}->{"no"}
= [ "Du kan trenge å bruke browserens \<\;Reload\>\; knapp<BR>",
"eller til og med",
"\<\;Tastatur Shift\>\;+\<\;Browser Reload\>\;<BR>",
"for å bli kvitt denne siden etter endring i adgangskontrollen" ];
%msg->{"refresh"}->{"tr"}
= [ "Erişim kuralları değişikliğinden sonra bu sayfayı, <BR>tarayıcınızın",
"\<\;Yeniden Yükle\>\; tuşunu<BR>",
"veya \<\;Shift\>\;+\<\;Yeniden Yükle\>\; kullanarak<BR>",
"yeniden yüklemeniz gerekebilir" ];
%msg->{"timerefresh"}->{"en"}
= [ "You may need to use the browser's \<\;Reload\>\; button<BR>",
"or even \<\;Keyboard Shift\>\;+\<\;Browser Reload\>\;<BR>",
"to get rid of this page after transition from<BR>",
"a time zone with access restrictions" ];
%msg->{"timerefresh"}->{"fr"}
= [ "Vous avez peut-être besoin d\'utiliser le bouton \<\;Recharger\>\;<BR>",
"ou même \<\;Shift\>\;+\<\;Recharger\>\;<BR>",
"après un changement de zone temporelle d\'interdiction" ];
%msg->{"timerefresh"}->{"no"}
= [ "Du kan trenge å bruke browserens \<\;Reload\>\; knapp<BR>",
"eller til og med",
"\<\;Tastatur Shift\>\;+\<\;Browser Reload\>\;<BR>",
"for å bli kvitt denne siden ved overgang fra",
"et tidsrom med sperring" ];
%msg->{"timerefresh"}->{"tr"}
= [ "Erişim kısıtlaması olan bir zaman diliminden çıktığınızda<BR> bu sayfayı, tarayıcınızın",
"\<\;Yeniden Yükle\>\; tuşunu<BR>",
"veya \<\;Shift\>\;+\<\;Yeniden Yükle\>\; kullanarak<BR>",
"yeniden yüklemeniz gerekebilir" ];
%msg->{"unknown"}->{"en"}
= [ "Access denied because<BR>",
"your clienten is<BR>",
"unknown to \$proxy"];
%msg->{"unknown"}->{"fr"}
= [ "Accès interdit car <BR>",
"votre client est <BR>",
"inconnu de \$proxy"];
%msg->{"unknown"}->{"no"}
= [ "Adgang nektes fordi<BR>",
"denne klienten ikke er<BR>",
"definert på \$proxy" ];
%msg->{"unknown"}->{"tr"}
= [ "Tarayıcınız \$proxy <BR>",
"tarafından tanınmadığından <BR>",
"erişiminiz engellendi" ];
%msg->{"in-addr"}->{"en"}
= [ "Surfing on plain <U>IP-addresses</U><BR>",
"is denied from this client<BR>",
"for security reasons" ];
%msg->{"in-addr"}->{"fr"}
= [ "Naviguer sur des <U>adresses IP</U><BR>",
"est refusé à cette machine<BR>",
"pour des raisons de sécurité" ];
%msg->{"in-addr"}->{"no"}
= [ "Av sikkerhetsgrunner er<BR>",
"surfing på <U>IP-adresser</U><BR>",
"ikke tillatt fra denne klienten" ];
%msg->{"in-addr"}->{"tr"}
= [ "Güvenlik nedeni ile IP adreslerini",
"kullanarak bu istemciden sörf yapmak",
"yasaklanmıştır." ];
%msg->{"alternatives"}->{"en"}
= [ "The following possible alternatives were found:" ];
%msg->{"alternatives"}->{"fr"}
= [ "Les alternatives suivantes sont possibles:" ];
%msg->{"alternatives"}->{"no"}
= [ "Følgende mulige alternativer ble funnet:" ];
%msg->{"alternatives"}->{"tr"}
= [ "Aşağıdaki alternatifler bulundu:" ];
%msg->{"noalternatives"}->{"en"}
= [ "No alternative domainname were found<BR>",
"for the server <U>\$address</U>" ];
%msg->{"noalternatives"}->{"fr"}
= [ "Aucun nom de domaine alternatif n\'a été<BR>",
"trouvé pour le serveur <U>\$address</U>" ];
%msg->{"noalternatives"}->{"no"}
= [ "Finner alternative ingen domenenavn<BR>",
" for serveren <U>\$address</U>" ];
%msg->{"noalternatives"}->{"en"}
= [ "Sunucu <U>\$address</U> için başka<BR>",
"alan adı alternatifi bulunamadı" ];
%msg->{"referermaster"}->{"en"}
= [ "Send complaints to the",
"<A HREF=\\\"mailto:webmaster\@\$refererhost\\\">webmaster</A><BR>",
"of <A HREF=\\\"\$referer\\\">\$referer</A><BR>",
"and ask him to correct the link(s) that points to \$url<BR>",
"in <A HREF=\\\"\$referer\\\">\$referer</A>,<BR>",
"with the supposedly correct alternative above" ];
%msg->{"referermaster"}->{"fr"}
= [ "Envoyez les demandes au",
"<A HREF=\\\"mailto:webmaster\@\$refererhost\\\">webmaster</A><BR>",
"de <A HREF=\\\"\$referer\\\">\$referer</A><BR>",
"et demandez lui corriger les liens qui pointent sur \$url<BR>",
"dans <A HREF=\\\"\$referer\\\">\$referer</A>,<BR>",
"avec l\'alternative (supposée correcte) suivante" ];
%msg->{"referermaster"}->{"no"}
= [ "Send evt. klager til",
"<A HREF=\\\"mailto:webmaster\@\$refererhost\\\">webmaster</A><BR>",
"for <A HREF=\\\"\$referer\\\">\$referer</A><BR>",
"og be ham rette linken(e) som peker til \$url<BR>",
"i <A HREF=\\\"\$referer\\\">\$referer</A>,<BR>",
"med det antatt korrekte alternativet over" ];
%msg->{"referermaster"}->{"tr"}
= [ "Şikayetlerinizi <A HREF=\\\"\$referer\\\">\$referer</A>'in",
"<A HREF=\\\"mailto:webmaster\@\$refererhost\\\">webyöneticisine</A><BR>",
"bildirin ve <A HREF=\\\"\$referer\\\">\$referer</A>'de <BR>",
"\$url'e işaret eden bağları, yukarıda bulunan alternatifle<BR>",
"değiştirmesini rica edin." ];
%msg->{"webmaster"}->{"en"}
= [ "Send complaints to the <U>webmaster</U>",
"for <U>\$protocol://\$address</U><BR>",
"and request for a <EM>domainname</EM> to the server" ];
%msg->{"webmaster"}->{"fr"}
= [ "Envoyez les demandes au <U>webmaster</U>",
"pour <U>\$protocol://\$address</U><BR>",
"et demandez un <EM>nom de domaine</EM> pour le serveur" ];
%msg->{"webmaster"}->{"no"}
= [ "Send evt. klager til <U>webmaster</U>",
"for <U>\$protocol://\$address</U><BR>",
"og anmod om å få knyttet serveren til et <EM>domenenavn</EM>" ];
%msg->{"webmaster"}->{"tr"}
= [ "<U>\$protocol://\$address</U> için",
"şikayetlerinizi <U>webyöneticisine</U>",
"bildirin ve sunucu için <BR>",
"<EM>alan adı</EM> isteyin" ];
%msg->{"deflang"}->{"en"}
= [ "This message is in English because \\\"en\\\"",
"is the first supported language<BR>",
"of those your browser is set up",
"to report as prefered.<BR>",
"Supported languages are:",
@supported ];
%msg->{"deflang"}->{"fr"}
= [ "Ce message est en français car \\\"fr\\\"",
"est la première langue supportée<BR>",
"parmi celles que votre navigateur signale comme",
"préférée.<BR>",
"Les langues supportées sont:",
@supported ];
%msg->{"deflang"}->{"no"}
= [ "Denne meldingen er på norsk fordi \\\"no\\\"",
"er det første støttede sproget<BR>",
"av de din nettleser er satt opp til",
"å rapportere som foretrukket.<BR>",
"Støttede sprog er:",
@supported ];
%logo->{"default"}->{"url"}
= "http://www.squidguard.org/images/squidGuard.gif";
%logo->{"default"}->{"href"}
= "http://www.squidguard.org/";
%logo->{"default"}->{"url"}
= "http://10.254.254.254/forbidden.gif";
%logo->{"default"}->{"href"}
= "http://10.254.254.254";
}
#
# END OF CONFIGURABLE OPTIONS
#
#
# SUBROUTINES:
#
#
# RETURN THE FIRST SUPPORTED LANGUAGE OF THE BROWSERS PREFERRED OR THE
# DEFAULT:
#
sub getpreferedlang(@) {
my @supported = @_;
my @languages = split(/\s*,\s*/,$ENV{"HTTP_ACCEPT_LANGUAGE"}) if(defined($ENV{"HTTP_ACCEPT_LANGUAGE"}));
my $lang;
my $supp;
push(@languages,$supported[0]);
for $lang (@languages) {
$lang =~ s/\s.*//;
for $supp (@supported) {
$supp =~ s/\s.*//;
return($lang) if ($lang eq $supp);
}
}
}
#
# PARSE THE QUERY_STRING FOR KNOWN KEYS:
#
sub parsequery($) {
my $query = shift;
my $clientaddr = %word->{"unknown"}->{$lang};
my $clientname = %word->{"unknown"}->{$lang};
my $clientuser = %word->{"unknown"}->{$lang};
my $clientgroup = %word->{"unknown"}->{$lang};
my $targetgroup = %word->{"unknown"}->{$lang};
my $url = %word->{"unknown"}->{$lang};
if (defined($query)) {
while ($query =~ /^\&?([^\&=]+)=\"([^\"]*)\"(.*)/ || $query =~ /^\&?([^\&=]+)=([^\&=]*)(.*)/) {
my $key = $1;
my $value = $2;
$value = %word->{"unknown"}->{$lang} unless(defined($value) && $value && $value ne "unknown");
$query = $3;
if ($key =~ /^(clientaddr|clientname|clientuser|clientgroup|targetgroup|url)$/) {
eval "\$$key = \$value";
}
if ($query =~ /^url=(.*)/) {
$url = $1;
last;
}
}
}
return($clientaddr,$clientname,$clientuser,$clientgroup,$targetgroup,$url);
}
#
# PRINT HTTP STATUS HEARER:
#
sub status($) {
my $status = shift;
print "Status: $status\n";
}
#
# PRINT HTTP LOCATION HEARER:
#
sub redirect($) {
my $location = shift;
print "Location: $location\n";
}
#
# PRINT HTTP CONTENT-TYPE HEARER:
#
sub content($) {
my $contenttype = shift;
print "Content-Type: $contenttype\n";
}
#
# PRINT HTTP LAST-MODIFIED AND EXPIRES HEARER:
#
sub expires($) {
my $ttl = shift;
my $time = time;
my @day = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
my @month = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
printf "Last-Modified: %s, %d %s %d", $day[$wday],$mday,$month[$mon],$year+1900;
printf " %02d:%02d:%02d GMT\n", $hour,$min,$sec;
($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time+$ttl);
printf "Expires: %s, %d %s %d", $day[$wday],$mday,$month[$mon],$year+1900;
printf " %02d:%02d:%02d GMT\n", $hour,$min,$sec;
}
#
# PRINT THE INITIAL HTML TAGS FOR HTML, HEAD, TITLE BODY AND H1:
#
sub title($) {
my $msgid = shift;
my $defl = $supported[0];
my $text;
$defl =~ s/\s.*//;
print "\n<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"\n";
print " \"http://www.w3.org/TR/html4/loose.dtd\">\n";
print "\n<HTML>\n";
print " <HEAD>\n <TITLE>\n";
if (defined($msg{$msgid}{$lang})) {
for $text (@{$title{$msgid}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
} else {
for $text (@{$title{"default"}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
}
if ($lang eq "tr" ) {
print " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-9\">\n";
}
print " </TITLE>\n </HEAD>\n";
print " <BODY BGCOLOR=\"#FFFFFF\">\n";
print " <TABLE BORDER=0 ALIGN=CENTER WIDTH=100%>\n";
print " <TR>\n";
print " <TD ALIGN=LEFT VALIGN=BOTTOM>\n";
print " <FONT SIZE=7>\n";
print " <B>\n <U>\n";
if (defined($msg{$msgid}{$lang})) {
for $text (@{$title{$msgid}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
} else {
for $text (@{$title{"default"}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
}
print " </U>\n </B>\n";
print " </FONT>\n";
print " </TD>\n";
print " <TD ROWSPAN=2 ALIGN=RIGHT>\n";
if (defined($logo{$msgid}{"url"})) {
print " <A HREF=\"$logo{$msgid}{\"href\"}\"><IMG\n";
} else {
print " <A HREF=\"$logo{\"default\"}{\"href\"}\"><IMG\n";
}
if (defined($logo{$msgid}{"url"})) {
print " SRC=\"$logo{$msgid}{\"url\"}\" BORDER=0 ALIGN=TOP></A>\n";
} else {
print " SRC=\"$logo{\"default\"}{\"url\"}\" BORDER=0 ALIGN=TOP></A>\n";
}
print " </TD>\n";
print " </TR>\n";
if ($lang eq $defl && defined($msg{"deflang"}{$lang})) {
print " <TR><!-- \$msg{\"deflang\"}{$lang} -->\n";
print " <TD ALIGN=LEFT VALIGN=TOP>\n";
print " <FONT >\n";
print " <B>\n";
for $text (@{$msg{"deflang"}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
print " </B>\n";
print " </FONT>\n";
print " </TD>\n";
print " </TR>\n";
}
print " </TABLE>\n";
}
#
# PRINT THE ENDING HTML TAGS FOR BODY AND HTML:
#
sub terminator() {
print " </BODY>\n</HTML>\n";
}
#
# PRINT A MESSAGE WITH THE SPECIFIED TYPE (P,H1,H2,..):
#
sub msg($$) {
my ($type,$msgid) = @_;
my $text;
print " <$type ALIGN=CENTER><!-- \$msg{$msgid}{$lang} -->\n";
if (defined($msg{$msgid}{$lang})) {
for $text (@{$msg{$msgid}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
} else {
print " <EM><B>ERROR: missing message \"$msgid\"</B></EM>\n";
}
print " </$type>\n";
}
#
# PRINT A TABLE WITH THE SPECIFIED FORMAT:
#
sub table($$@) {
my @format = split(/,/,shift);
my $table = shift;
my $cols = @format;
my @msgids = @_;
my $msgid;
my $text;
my %type;
%type->{"L"} = [ "<TD ALIGN=LEFT>", "</TD>" ];
%type->{"C"} = [ "<TD ALIGN=CENTER>", "</TD>" ];
%type->{"R"} = [ "<TD ALIGN=RIGHT>", "</TD>" ];
%type->{"l"} = [ "<TD ALIGN=LEFT>", "</TD>" ];
%type->{"c"} = [ "<TD ALIGN=CENTER>", "</TD>" ];
%type->{"r"} = [ "<TD ALIGN=RIGHT>", "</TD>" ];
print " <TABLE BORDER=0 ALIGN=CENTER><!-- table(\"$table\") -->\n";
if (defined($tab{$table})) {
if (defined($tab{$table}{"caption"}{$lang})) {
#print " <CAPTION ALIGN=LEFT>\n";
print " <TD ALIGN=LEFT>\n";
print " <FONT SIZE=+1>\n";
for $text (@{$tab{$table}{"caption"}{$lang}}) {
eval "\$text = \"$text\"";
print " $text\n";
}
print " </FONT>\n";
#print " </CAPTION>\n";
print " </TD>\n";
}
for $msgid (@msgids) {
print " <TR>\n";
if (defined($tab{$table}{$msgid}{$lang})) {
my $i = 0;
for $text (@{$tab{$table}{$msgid}{$lang}}) {
eval "\$text = \"$text\"";
print " $type{$format[$i]}[0]\n";
print " $text\n";
print " $type{$format[$i]}[1]\n";
$i++;
}
} else {
print " $type{$format[0]}[0]\n";
print " <EM><B>ERROR: missing table message \"$msgid\"</B></EM>\n";
print " $type{$format[0]}[1]\n";
}
print " </TR>\n";
}
} else {
print " <TR>\n";
print " <TD ALIGN=CENTER>\n";
print " <EM><B>ERROR: missing message \"$msgid\"</B></EM>\n";
print " </TD>\n";
print " </TR>\n";
}
print " </TABLE>\n";
}
#
# PRINT A LINK HREF:
#
sub href($) {
my $href = shift;
print "<A HREF=\"$href\">$href</A>";
}
#
# REVERSE LOOKUP AND RETURN NAMES:
#
sub gethostnames($) {
my $address = shift;
my ($name,$aliases) = gethostbyaddr(inet_aton($address), AF_INET);
my @names;
if (defined($name)) {
push(@names,$name);
if (defined($aliases) && $aliases) {
for(split(/\s+/,$aliases)) {
next unless(/\./);
push(@names,$_);
}
}
}
return(@names);
}
#
# SPLIT AN URL INTO PROTOCOL, ADDRESS, PORT AND PATH:
#
sub spliturl($) {
my $url = shift;
my $protocol = "";
my $address = "";
my $port = "";
my $path = "";
$url =~ /^([^\/:]+):\/\/([^\/:]+)(:\d*)?(.*)/;
$protocol = $1 if(defined($1));
$address = $2 if(defined($2));
$port = $3 if(defined($3));
$path = $4 if(defined($4));
return($protocol,$address,$port,$path);
}
#
# SHOW THE CONFIGURED MESSAGE AS HTML:
#
sub showhtml($) {
my $msgid = shift;
status("403 Forbidden");
content("text/html");
expires(0);
title($msgid);
$msgid = "default" unless(defined($msgconf{$msgid}));
if (defined($msgconf{$msgid})) {
print " <!-- showhtml(\"$msgid\") -->\n";
for (@{$msgconf{$msgid}}) {
my @config = split(/:/);
my $type = shift(@config);
if ($type eq "msg") {
msg($config[0],$config[1]);
} elsif ($type eq "tab") {
table(shift(@config),shift(@config),@config);
}
}
} else {
print " <P><EM><B>ERROR: missing msgconf for \"$msgid\"</B></EM></P>\n";
}
terminator();
}
#
# SEND OUT AN IMAGE:
#
sub showimage($$$) {
my ($type,$file,$redirect) = @_;
content("image/$type");
expires(300);
redirect($redirect) if($redirect);
print "\n";
open(GIF, "$ENV{\"DOCUMENT_ROOT\"}$file");
print <GIF>;
close(GIF)
}
#
# SHOW THE INADDR ALERNATIVES WITH OPTIONAL ATOREDIRECT:
#
sub showinaddr($$$$$) {
my ($targetgroup,$protocol,$address,$port,$path) = @_;
my $msgid = $targetgroup;
my @names = gethostnames($address);
if($autoinaddr == 2 && @names || $autoinaddr && @names==1) {
status("301 Moved Permanently");
redirect("$protocol://$names[0]$port$path");
} elsif (@names>1) {
status("300 Multiple Choices");
} elsif (@names) {
status("301 Moved Permanently");
} else {
status("404 Not Found");
}
if ($path =~ /\.(gif|jpg|jpeg|mp3|mpg|mpeg|avi|mov)$/i) {
showimage("gif",$image,$redirect);
} elsif (@names) {
content("text/html");
expires(0);
title($msgid);
$msgid = "in-addr" unless(defined($msgconf{$msgid}));
if (defined($msgconf{$msgid})) {
print " <!-- showinaddr(\"$msgid\") -->\n";
for (@{$msgconf{$msgid}}) {
my @config = split(/:/);
my $type = shift(@config);
if ($type eq "msg") {
msg($config[0],$config[1]);
} elsif ($type eq "tab") {
table(shift(@config),shift(@config),@config);
} elsif ($type eq "alternatives") {
print " <TABLE BORDER=0 ALIGN=CENTER>\n";
for (@names) {
print " <TR>\n <TD ALIGN=LEFT>\n <FONT SIZE=+1>";
href("$protocol://$_$port$path");
print "\n </FONT>\n </TD>\n </TR>\n";
}
print " </TABLE>\n\n";
if (defined($ENV{"HTTP_REFERER"}) && $ENV{"HTTP_REFERER"} =~ /:\/\/([^\/:]+)/) {
$refererhost = $1;
$referer = $ENV{"HTTP_REFERER"};
msg("H4","referermaster");
}
}
}
} else {
print " <P><EM><B>ERROR: missing msgconf for \"$msgid\"</B></EM></P>\n";
}
terminator();
} else {
showhtml("noalternatives");
}
}
#
# NOW JUST DO IT:
#
msginit();
if ($targetgroup eq "in-addr") {
showinaddr($targetgroup,$protocol,$address,$port,$path);
} elsif ($url =~ /\.(gif|jpg|jpeg|mp3|mpg|mpeg|avi|mov)$/i) {
status("403 Forbidden");
showimage("gif",$image,$redirect);
} else {
showhtml($clientgroup);
}
exit 0;