#!/usr/bin/perl -w
#
# This program is free software. You can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation, either version 1 or
# (at your option) any later version,
my ($r_adr,$r_hst,$r_rfr,$r_str) = ($ENV{'REMOTE_ADDR'},$ENV{'REMOTE_HOST'},$ENV{'HTTP_REFERER'},$ENV{'QUERY_STRING'});
#my ($r_rfr,$r_hst,$r_adr) = ('Host name','http://..','192.168.0.34');
#my $r_str = "link=about=++";
#my $r_str = "link=about=+e5+c5+t5+";
#my $cookie = new CGI::Cookie(-name=>'EXTID',-value=>'guest',-expires => '+3M');
use CGI qw/:standard/;
use CGI::Cookie;
my $time = localtime;
my $err_on = 1;
my $clk_on = 1;
my $test_p = 0;
#if ($test_p == 1) {}@tmp = undef;
my ($auth_lvl,$cmd,$loc,$content,$cnt_file);
my (@parm,@do_parm,@dir_list,@subdir_list,@allowed_dirs,@c);
my ($tmp,@tmp);
# reduce the $ENV
sub read_tag {
if ($r_str =~ /^(\w+)=(.+)=(.+)/) {
$cmd = $1 or &int_err('002');
$loc = $2 or &int_err('003');
$tmp = $3 or &int_err('004');
while ($tmp =~ /(\++)(\w+)/g) {
push(@parm,$2) or &int_err('004');
}
}
if ($test_p == 1) {print "The command : $cmd\nThe location : $loc\n";foreach (@parm) {print "Parm : $_\n"}}$tmp= undef;
}
# process parms
sub first_parms {
my $parm_file = 'DB/parms/list.txt'; # Swop external parameters for internal ones
my ($ext_parm,$int_parm);
open(PARMFILE, "<$parm_file") or &int_err('005');
my @p = <PARMFILE>;
foreach (@p) {
$_ =~ s/\s$//;
$_ =~ /(^\w+)=(.+)/;
($ext_parm,$int_parm) = ($1,$2);
foreach (@parm) {
$tmp = $_;
if ($tmp eq $ext_parm) {push(@do_parm,$int_parm)}
}
}
close(PARMFILE);
if ($test_p == 1 ) {foreach (@do_parm) {print "$_\n"}}$tmp= undef;
# this could get heavy ! ! ! define all paramters
foreach (@do_parm) {
if ($_ eq 'nocnt') {$clk_on = 0}
if ($_ eq 'noerr') {$err_on = 0}
if ($_ eq 'test') {$test_p = 1}
if ($_ eq 'no') {}
}
}
# fetch existing cookies
my($cookie1,$extid);
sub get_cookies {
%cookies = fetch CGI::Cookie;
if (! %cookies) {
my $gst_f = 'DB/accounts/guests_name.txt';
open(GSTFILE, "$gst_f") or &int_err('093');
@tmp = <GSTFILE>;
foreach (@tmp) {$_ =~ s/\s$//}
close(GSTFILE);
$a = $tmp[$#tmp];
$a =~ /(\d+)=/;
$tmp = $1;
$a = undef;
$tmp++;
$extid = 'nc'.$tmp;
open(GSTFILE, ">>$gst_f") or &int_err('093');
print GSTFILE "$extid=guest$tmp\n";
close(GSTFILE);
$cookie1 = new CGI::Cookie(-name=>'EXTID',-value=>"$extid",-expires => '+3M') or &int_err('001');
$auth_lvl = 0;
} else {
$extid = $cookies{'EXTID'}->value
}
if ($test_p == 1) {print "EXTID : $extid\n"}$tmp = undef;
}
# Check auth for restricted stuffs
sub check_auth {
my ($lvl0,$lvl1,$lvl2,$lvl3);
my $dir = 'DB/accounts/';
my ($usr_file,$mod_file,$admin_file) = ('usrs_name.txt','mods_name.txt','admin_name.txt');
# check users
#$extid = 'cmnr1';
open(USRFILE, "$dir"."$usr_file") or &int_err('097');
@tmp = <USRFILE>;
foreach (@tmp) {$_ =~ s/\s$//}
close(USRFILE);
foreach (@tmp) {
$_ =~ /(\w+)=/;
$tmp = $1;
if ($tmp eq $extid) {
$auth_lvl = 1;
}
}
# check mods
#$extid = 'mngr1';
open(MODFILE, "$dir"."$mod_file") or &int_err('098');
@tmp = <MODFILE>;
foreach (@tmp) {$_ =~ s/\s$//}
close(MODFILE);
foreach (@tmp) {
$_ =~ /(\w+)=/;
$tmp = $1;
if ($tmp eq $extid) {
$auth_lvl = 2;
}
}
# check admins
#$extid = 'daboss1';
open(ADMINFILE, "$dir"."$admin_file") or &int_err('099');
@tmp = <ADMINFILE>;
foreach (@tmp) {$_ =~ s/\s$//}
close(ADMINFILE);
foreach (@tmp) {
$_ =~ /(\w+)=/;
$tmp = $1;
if ($tmp eq $extid) {
$auth_lvl = 3;
}
}
if ($test_p == 1) {print "AUTH LVL : $auth_lvl\n"}$tmp = undef;
}
# run the command
sub run_cmd {
#cmd = link, mail, upld, dwld, dimg, lgin, lout
require "cmds/$cmd.pl" or &int_err('010');
&do_it($loc,$cookie1,$auth_lvl,@do_parm);
if ($cmd eq 'lgin') {
($loc) = @_ or &int_err('009');
}
if ($cmd eq 'lout') {
($loc,$cookie1) = @_ or &int_err('008');
#$loc = $y;
}
}
# prep dir for authorised content
sub prep_dir {
my $c_dir = 'content/';
opendir(DIR, $c_dir)
|| print "can't open $c_dir: $!";
@dir_list = grep { /^\w./ && "$c_dir/$_" } readdir(DIR);
closedir DIR;
foreach (@dir_list) {
if ($_ !~ /\.+/) {
push(@subdir_list,$_)
}
}
foreach (@subdir_list) {
if ($_ =~ /(\d+$)/) {
$tmp = $_;
if ($1 <= $auth_lvl) {
push(@allowed_dirs,$tmp);
}
}
}
if ($test_p == 1) {print "Access to : @allowed_dirs\n"}$tmp = undef;
}
# Try get content else return error (either unauth or not found)
sub get_content {
foreach (@allowed_dirs) {
$tmp = $_;
$dir = $tmp;
my $c_dir = 'content/'.$tmp.'/';
opendir(DIR, $c_dir) || print "can't open $c_dir: $!";
@dir = grep { /^\w./ && "$c_dir/$_" } readdir(DIR);
closedir DIR;
foreach (@dir) {
$tmp = $_;
if ($tmp =~ /$loc/) {
$cnt_file = "content/".$dir."/$tmp";
open(CONTENT, "$cnt_file");
@c = <CONTENT>;
close(CONTENT);
}
}
}
if (! @c) {
$cnt_file = "content/err/unauth.txt";
open(NOAUTH, "$cnt_file") or &int_err('014');
@c = <NOAUTH>;
close(NOAUTH);
}
if ($test_p == 1) {print "CONTENT : $cnt_file\n"}$tmp = undef;
}
# log as much info about this click as pos
sub log_click {
if ($clk_on == 1 ) {
my $clk_log = 'DB/logs/clicks/'.$loc.'.txt'; # log the users info and IP
open(CLKLOG, ">>$clk_log") or &int_err('091');
print CLKLOG "$extid = $r_hst = $time\n";
close(CLKLOG);
# counter
my $clk_count = 'DB/counters/content.txt'; # log the click counter
my $n;
open(COUNTFILE, "<$clk_count") or &int_err('092');
$n = <COUNTFILE>;
$n++;
close(COUNTFILE);
open(COUNTFILE, ">$clk_count") or &int_err('092');
print COUNTFILE $n;
close(COUNTFILE);
if ($test_p == 1) {print "LOGGED : $clk_log\nINCR : $clk_count\n"}$tmp = undef;
}
}
# print HTML
sub print_html {
print header(-cookie=>[$cookie]) or &int_err('013');
print <<ENDHTML;
<HTML>
<HEAD>
ENDHTML
foreach (@c) {
print "$_\n";
}
print <<ENDHTML;
</BODY>
</HTML>
ENDHTML
exit;
}
# internal errors
sub int_err {
my ($err_no) = @_;
if ($err_on == 1) {
my $err_file = 'DB/errors/int.txt';
open(ERRFILE, "$err_file");
my @e = <ERRFILE>;
foreach (@e) {
$_ =~ s/\s$//;
$_ =~ /(^\d+)=(\w.+)/;
if ($err_no == $1) {
my $e = $1; # some where here need to get error content from file
@c = $2; # $errorcode = $1 $error_explination = $2
}
&print_html;
}
close(ERRFILE);
my $err_log = 'DB/logs/errors.txt';
open(ERRLOG, ">>$err_log") or &int_err('090');
print ERRLOG "$err_no = $extid = $r_hst = $time\n";
close(ERRLOG);
if ($test_p == 1) {print "ERROR $err_no : @c\n"}$tmp = undef;
}
}
# run the subs
read_tag;
first_parms;
get_cookies;
check_auth;
run_cmd;
prep_dir;
get_content;
log_click;
if ($test_p == 0) {print_html}
