#!/usr/local/bin/perl -w
#
# Unpublished Test Version
#
$version="2.6.1IM";
#
# (c) 1997 Emmanuel PIERRE
#          epierre@mail.esiea.fr
#          http://www.esiea.fr/public_html/Emmanuel.PIERRE
#
# Developed at/by:
#          Ecole Supérieure d'Informatique-Electronique-Automatique
#          a project of the School Intranet Web Server
#
#          http://hp1.esiea.fr:2001
#
#
require 5.002;
#use strict;
use strict 'subs';

BEGIN { $ENV{PATH} = '/usr/bin:/bin' }
use IO::Socket;
use IO::Handle;
use Carp;
use Net::Domain qw(hostname hostfqdn hostdomain);
use Net::Ping;
use Fcntl;

sub spawn;  # forward declaration
sub logmsg { 
	#print "$0 $$: @_ at ", scalar localtime, "\n" 
}

my $waitedpid = 0;
my $paddr;
my $serv_port=12345;

my $server_name = "http://www.esiea.fr:8080";
my $pere_pid=$$;

&Init_Server;
&Sig_Intercept;
&Wait_Connection;

exit;

sub Wait_Connection {
#
# Boucle d'attente de connection
#
for ( $waitedpid = 0;
     ($paddr = accept(Client,Server)) || $waitedpid;
      $waitedpid = 0, close Client)
           {
               #next if $waitedpid;
               my($port,$iaddr) = sockaddr_in($paddr);
               my $name = gethostbyaddr($iaddr,AF_INET);

               logmsg "connection from $name [",
                       inet_ntoa($iaddr), "]
                       at port $port";

               spawn sub {
                        &gere_connection(*Client);
               };
           }
}


sub gere_connection {
#
# Routine de gestion d'une connection
#

    local(*Client) = $_[0];

    my $counter=0;
    my $buffer="";
    my $inbuffer="";
    my ($res,$serv,$port);

    my $charger=`/usr/bin/uptime`;
    my ($charge)=($charger=~/average:\s(\d*\.\d+)/);
    local $ftime = localtime (time);

    $buffer="[$charge][$hostname] MoXWorld Agent Server v$version (C)Emmanuel PIERRE 1997\n";

   my $code_ret=0;

    while (1)
    {
#	last if (sysread(Client, $buffer, 512)<=0);

        if (sysread(Client, $inbuffer, 512)<=0) {
                &close_all;
        }

        #code_ret = recv(Client, $buffer, 512,0);

        print STDOUT "Recu : >", $inbuffer, "<\n";
	
	# bricolage pour mauvaise connection...
	#$counter++;
	
	#if ($counter>10) {
	#	&close_all;
	#}
        
	#last if ($inbuffer =~ /BYE/);
        last if ($inbuffer eq "BYE\r\n");

        if (($inbuffer=~ /GET \/SHUTDOWN/)) {
                kill('USR2',$pere_pid);
                #print "kill USR2 $pere_pid\n";
                &close_all;
        }
	
	if ($inbuffer =~ /GET \/IDENT/) {
                $buffer.="IDENT= $hostname:$serv_port\r\n\r\n";
                syswrite(Client, $buffer, length($buffer));
        	last;
        }
	
	if ($inbuffer =~ /HEAD/) {
                $buffer="HTTP/1.1 200 OK\r\nDate: $ftime\r\nServer: MoXWorld Agent Server v$version\r\nConnection: close\r\nContent-Type: text/html\r\n\r\n";
                syswrite(Client, $buffer, length($buffer));
        	last;
        }
        

        if  ($inbuffer =~ /GET \/pages/) {
                #
                # Moulinette
                #
                &get_pages;
                foreach $id (keys %pageres) {
                        $buffer.="$pageres{$id}\n";
                }
                syswrite(Client, $buffer, length($buffer));
        last;
        }

        if  ($inbuffer =~ /GET \/activ/) {
                #
                # Moulinette
                #
                &get_activ;
                foreach $id (keys %activres) {
                        $buffer.="$activres{$id}\n";
                }
                syswrite(Client, $buffer, length($buffer));
        last;
        }
        if  ($inbuffer =~ /GET \/proj/) {
                #
                # Moulinette
                #
                &get_proj;
                foreach $id (keys %projres) {
                        $buffer.="$projres{$id}\n";
                }
                syswrite(Client, $buffer, length($buffer));
        last;
        }
        if  ($inbuffer =~ /GET \/cv/) {
                #
                # Moulinette
                #
                &get_cv;
                foreach $id (keys %cvres) {
                        $buffer.="$cvres{$id}\n";
                }
                syswrite(Client, $buffer, length($buffer));
        last;
        }
        if  ($inbuffer =~ /GET \/dob/) {
                #
                # Moulinette
                #
                &get_dob;
                foreach $id (keys %dobres) {
			(@liste)=split(/\n/,$dobres{$id});
 			while (@liste) {
				$loc=pop(@liste);
                        	$buffer.="$id\t$loc\n";
			}
                }
                syswrite(Client, $buffer, length($buffer));
        last;
        }

        if  ($inbuffer =~ /GET \//) {
		if ($inbuffer=~ /\.gif/) {
			($fic)=($inbuffer=~/\/(.*\.gif)/);
			#$buffer="Content-Type: image/gif\r\n\r\n";
			$buffer="";
			open(FIC,$fic);
			while (<FIC>) {
				$buffer.=$_;
			}
			close(FIC);
			#print "-$buffer-\n";
		} else {
		$buffer="<HTML><HEAD>\r\n<TITLE>MoXWorld Agent Server v$version</TITLE>\r\n</HEAD><BODY BGCOLOR=#FFFFF>\r\n<H1>MoXWorld Agent Server v$version<HR></H1>\r\n<BR><BR>\r\nThis is our experimental Distributed User Agent, see documentation at <A HREF=\"http://www.esiea.fr/public_html/Emmanuel.PIERRE\">Emmanuel PIERRE</A> home page.\r\n<IMG SRC=\"a.gif\"><IMG SRC=\"a.gif\"></BODY></HTML>\r\n";
		}
                syswrite(Client, $buffer, length($buffer));
        last;
        }

    	$buffer= "<HTML><HEAD>\r\n<TITLE>400 Bad Request</TITLE>\r\n</HEAD><BODY>\r\n<H1>Bad Request</H1>\r\nYour browser sent a request that\r\nthis server could not understand.<P>\r\n</BODY></HTML>\r\n";
    	syswrite(Client, $buffer, length($buffer));
    	last;
    }

    #print "Closing connection.\n";
    close(Client);
}


sub get_pages {

        # Read the real name from passwd file

        open(PW,"/etc/passwd");
        while (<PW>) {
                chop;
                ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/);
                ($real) = split(/,/, $gcos);
                if ($uid>10) {
                        push @tliste, $user.":".$real.":".$dir."\n";
                }
        }
        close(PW);

        @tliste = sort @tliste;
        @tliste = reverse @tliste;

        while (@tliste) {
                ($user,$real,$dir)=split(/:/,pop @tliste);
                chomp($dir);
                chomp($real);
                chomp($user);

                $nom="";
                $url="";

                if (-r $dir."/.webpagelist") {
                        # si on a affaire à une liste
                        open(FIC,$dir."/.webpagelist");

                        while(<FIC>) {
                                chomp;
                                ($nom,$real,$url,$logo)=split(/\t/,$_);
				chomp($nom);
				chomp($url);
				chomp($real);
				chomp($logo);
                                if ($url ne "") {
                                        $pageres{$nom}="$nom\t$url\t$real\n";
                                        #print "1-$pageres{$nom}";
                                }
                        }
                        close(FIC);
                } else {
                        if (-r $dir."/.webredirect") {
                                open(FIC,$dir."/.webredirect");
                                $url=<FIC>;
                                close(FIC);
				chomp($url);	
                        } else {
                                if (-r $dir."/public_html/page/index.html") {
                                        $url="$server_name/~$user/page/index.html";
                                } elsif (-r $dir."/public_html/index.html") {
                                        $url="$server_name/~$user/index.html";
                                } elsif (-r $dir."/Welcome.html") {
                                        $url="$server_name$dir/Welcome.html";
                                } 
                                if ($url ne "") {
                                        $pageres{$user}="$user\t$url\t$real\n";
                                        #print "2-$pageres{$user}";
                                }
                        }
                }
        }
}

sub get_cv {

        # Read the real name from passwd file

        open(PW,"/etc/passwd");
        while (<PW>) {
                chop;
                ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/);
                ($real) = split(/,/, $gcos);
                if ($uid>10) {
                        push @tliste, $user.":".$real.":".$dir."\n";
                }
        }
        close(PW);

        @tliste = sort @tliste;
        @tliste = reverse @tliste;

        while (@tliste) {
                ($user,$real,$dir)=split(/:/,pop @tliste);
                chomp($dir);
                chomp($real);
                chomp($user);
                $nom="";
                $url="";

                if (-r $dir."/.webcvlist") {
                        # si on a affaire à une liste
                        open(FIC,$dir."/.webcvlist");

                        while(<FIC>) {
                                chomp;
                                ($nom,$real,$url,$logo)=split(/\t/,$_);
				chomp($nom);
				chomp($url);
				chomp($real);
				chomp($logo);
                                if ($url ne "") {
                                        $cvres{$nom}="$nom\t$url\t$real\n";
                                        #print "1-$cvres{$nom}";
                                }
                        }
                        close(FIC);
                } else {
                        if (-r $dir."/.webcvredirect") {
                                open(FIC,$dir."/.webcvredirect");
                                $url=<FIC>;
                                close(FIC);
				chomp($url);	
                        } else {
                                if (-r $dir."/cv.html") {
                                        $url="$server_name$dir/cv.html";
                                }
                                if (-r $dir."/public_html/cv/index.html") {
                                        $url="$server_name/~$user/cv/index.html";
                                }
                                if ($url ne "") {
                                        $cvres{$user}="$user\t$url\t$real\n";
                                        #print "2-$cvres{$user}";
                                }
                        }
                }
        }
}


sub get_activ {

        # Read the real name from passwd file

        open(PW,"/etc/passwd");
        while (<PW>) {
                chop;
                ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/);
                ($real) = split(/,/, $gcos);
                if ($uid>10) {
                        push @tliste, $user.":".$real.":".$dir."\n";
                }
        }
        close(PW);

        @tliste = sort @tliste;
        @tliste = reverse @tliste;

        while (@tliste) {
                ($user,$real,$dir)=split(/:/,pop @tliste);
                chomp($dir);
                chomp($user);
                chomp($real);

                $nom="";
                $logo="";
                $url="";

                if (-r $dir."/.webactivlist") {
                        # si on a affaire à une liste
                        open(FIC,$dir."/.webactivlist");

                        while(<FIC>) {
                                chomp;
                                ($nom,$url,$logo)=split(/\t/,$_);
				chomp($nom);
				chomp($url);
				chomp($logo);
                                if ($url ne "") {
                                        $activres{$nom}="$nom\t$url\t$logo\n";
                                        #print "1-$activres{$nom}";
                                }
                        }
                        close(FIC);
                } else {
                        if (-r $dir."/.webactivname") {
                                open(FIC,$dir."/.webactivname");
                                $nom=<FIC>;
                                close(FIC);
				chomp($nom);
                                if (-r $dir."/.webactivredirect") {
                                        open(FIC,$dir."/.webactivredirect");
                                        $url=<FIC>;
                                        close(FIC);
					chomp($url);
                                } else {
                                        if (-r $dir."/public_html/activ/index.html") {
                                                $url="$server_name/~$user/activ/index.html";
                                        }
                                }
                                if (-r $dir."/public_html/activ/minilogo.gif") {
                                        $logo="$server_name/~$user/activ/minilogo.gif";
                                }
                                if ($url ne "") {
                                        $activres{$nom}="$nom\t$url\t$logo\n";
                                        #print "2-$activres{$nom}";
                                }
                        }
                        if ((-r $dir."/.webtpfhname")) {
                                open(FIC,$dir."/.webtpfhname");
                                $nom=<FIC>;
                                close(FIC);
				chomp($nom);	
                                if (-r $dir."/.webtpfhredirect") {
                                        open(FIC,$dir."/.webtpfhredirect");
                                        $url=<FIC>;
                                        close(FIC);
					chomp($url);
                                } else {
                                        if (-r $dir."/public_html/tpfh/index.html") {
                                                $url="$server_name/~$user/tpfh/index.html";
                                        }
                                }
                                if (-r $dir."/public_html/tpfh/minilogo.gif") {
                                        $logo="$server_name/~$user/tpfh/minilogo.gif";
                                }
                                if ($url ne "") {
                                        $activres{$nom}="$nom\t$url\t$logo\n";
                                        #print "3-$activres{$nom}";
                                }
                        }
                }
        }
}

sub get_proj {

        # Read the real name from passwd file

        open(PW,"/etc/passwd");
        while (<PW>) {
                chop;
                ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/);
                ($real) = split(/,/, $gcos);
                if ($uid>10) {
                        push @tliste, $user.":".$real.":".$dir."\n";
                }
        }
        close(PW);

        @tliste = sort @tliste;
        @tliste = reverse @tliste;

        while (@tliste) {
		$nom="";
		$logo="";
                ($user,$real,$dir)=split(/:/,pop @tliste);
                chomp($dir);
		chomp($real);
		chomp($user);

                if (-r $dir."/.webprojlist") {
                        # si on a affaire à une liste
                        open(FIC,$dir."/.webprojlist");

                        while(<FIC>) {
                                chomp;
                                ($nom,$url,$logo)=split(/\t/,$_);
				chomp($nom);
				chomp($url);
				chomp($logo);
                                if ($url ne "") {
                                        $projres{$nom}="$nom\t$url\t$logo\n";
                                        #print "1-$projres{$nom}";
                                }
                        }
                        close(FIC);
                } else {
                        if (-r $dir."/.webprojname") {
                                open(FIC,$dir."/.webprojname");
                                $nom=<FIC>;
                                close(FIC);
				chomp($nom);
                                if (-r $dir."/.webprojredirect") {
                                        open(FIC,$dir."/.webprojredirect");
                                        $url=<FIC>;
                                        close(FIC);
					chomp($url);
                                } else {
                                        if (-r $dir."/public_html/proj/index.html") {
                                                $url="$server_name/~$user/proj/index.html";
                                        }
                                }
                                if (-r $dir."/public_html/proj/minilogo.gif") {
                                        $logo="$server_name/~$user/proj/minilogo.gif";
                                }
                                if ($url ne "") {
                                        $projres{$nom}="$nom\t$url\t$logo\n";
                                        #print "2-$projres{$nom}";
                                }
                        }
                }
        }
}

sub get_dob {

        # Read the real name from passwd file

        open(PW,"/etc/passwd");
        while (<PW>) {
                chop;
                ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/);
                ($real) = split(/,/, $gcos);
                if ($uid>10) {
                        push @tliste, $user.":".$real.":".$dir."\n";
                }
        }
        close(PW);

        @tliste = sort @tliste;
        @tliste = reverse @tliste;

        while (@tliste) {
                ($user,$real,$dir)=split(/:/,pop @tliste);
                chomp($dir);
                chomp($real);
                chomp($user);
		my $dater="";
                my $nom=""; my $url=""; my $email=""; my $d1=""; my $d2=""; my $d3=""; my $DOB="";

                if (-r $dir."/.webDOBlist") {
                        # si on a affaire à une liste
                        open(FIC,$dir."/.webDOBlist");

		while(<FIC>) {
                                chomp;
                                ($DOB,$nom,$url,$email)=split(/\t/,$_);
                                ($d1,$d2,$d3)=split(/ /,$DOB);
                                $dater="$d2 $d1 $d3";
                                if (($nom ne "")&&($dater ne "")) {
                                        $dobres{$dater}.="$nom\t$url\t$email\n";
                                        #print "1-$hash{$dater}";
                                }
                        }
                        close(FIC);
                } else {
			if  (-r $dir."/public_html/perso/DOB") {
                                 open(FIC,$dir."/public_html/perso/DOB");
                                 $DOB=<FIC>;
                                 close(FIC);
                                 chomp($DOB);
                                 ($d1,$d2,$d3)=split(/ /,$DOB);
                                 $dater="$d2 $d1 $d3";
                                 $email="$user\@$hostname";
                                 chomp($email);

	                        if (-r $dir."/.webredirect") {
        	                        open(FIC,$dir."/.webredirect");
                	                $url=<FIC>;
                        	        close(FIC);
					chomp($url);	
	                        } else {
        	                        if (-r $dir."/Welcome.html") {
                	                        $url="$server_name$dir/Welcome.html";
                        	        }
                                	if (-r $dir."/public_html/index.html") {
                                        	$url="$server_name/~$user/index.html";
                                	}
				}
				chomp($dater);
                                if ($dater ne "  ") {
                                        $dobres{$dater}.="$real\t$url\t$email\n";
                                        #print "2-$hash{$dater}";
                                }
			}
		}
	}
}

sub close_all
{
    shutdown(Client, 2);
    shutdown(Server, 2);
    #print "Server shutdown... Goodbye.\n";
    exit(0);
}
sub close_cli
{
    shutdown(Server, 2);
    #print "Server shutdown... Goodbye.\n";
    exit(0);
}

sub timeout {
    $SIG{ALRM} = \&timeout;
    print "Socket Timeout\n";
    close(S);
}

sub spawn {
#
# Spawning de base
#
               my $coderef = shift;
               unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
                   confess "usage: spawn CODEREF";
               }

               my $pid;
               if (!defined($pid = fork)) {
                   logmsg "cannot fork: $!";
                   return;
               } elsif ($pid) {
                   logmsg "begat $pid";
                   return; # i'm the parent
               }
               # else i'm the child -- go spawn

               exit &$coderef();
}


sub REAPER {
               $SIG{CHLD} = \&REAPER;  # loathe sysV
               $waitedpid = wait;
               logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
           }


sub Sig_Intercept {
#
# Traitement des signaux
#
        $SIG{'INT'} = 'close_all';
        $SIG{'QUIT'} = 'close_all';
        $SIG{'USR2'} = 'close_all';
        $SIG{'PIPE'} = 'close_cli';
        $SIG{'TERM'} = 'close_cli';
        $SIG{CHLD} = \&REAPER;

}

sub log_pid {

	open(FICA,">./srv.pid");
	print FICA "$$\n";
	close(FICA);

}

sub Init_Server {
#
# Initialisation du serveur
#

        &log_pid;

        $hostname=&hostfqdn();
        chomp($hostname);

        $serv_port = shift || 12345;
        my $proto = getprotobyname('tcp');

        socket(Server, AF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
	
	#fcntl(Server,F_SETFL, O_NDELAY);

        setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
                                            pack("l", 1))   || die "setsockopt: $!";
        bind(Server, sockaddr_in($serv_port, INADDR_ANY))   || die "bind: $!" ;
        listen(Server,SOMAXCONN)                            || die "listen: $!";

        logmsg "server started on port $serv_port";

}

sub Connect_server {
#
# Connecion à un autre serveur
#
        my $server = $_[0];
        my $port   = $_[1];
        my $cmd    = $_[2];

        return if not (pingecho($server,10));

print "Connecting to $server:$port for $cmd\n";
        $cmd   .= "\r\n";
        my $res = "";
        my ($name,$aliases,$proto,$len,$thisadr,$thatadr,$this,$that,$sockaddr,$result);
        $sockaddr = 'S n a4 x8';

        chomp($hostname = `/bin/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($server);

        $this = pack($sockaddr, &AF_INET, 0, $thisaddr);

        $that = pack($sockaddr, &AF_INET, $port, $thataddr);

        if (!(socket(S, &PF_INET, &SOCK_STREAM, $proto))) {
                warn "socket: $!\n";
                return "socket: $!\n";
        }

        if (!(bind(S, $this))) {
                warn "bind: $!\n";
                return "bind: $!\n";
        }

        if (!(connect(S, $that))) {
                warn "connect: $!\n";
                return "connect: $!\n";
        }
        select(S); $| = 1; select(STDOUT);

#       $SIG{ALRM} =\&timeout;
#       alarm 10;

        syswrite(S,$cmd,length($cmd));
        last if (sysread(S, $buffer, 512)<=0);
        while ($buffer ne "") {
                print $buffer;
                $res.= $buffer;
                last if ($buffer=~/\r\n\r\n/);
                last if (sysread(S, $buffer, 512)<=0);
        #       syswrite(S, "BYE\r\n", 5);
        }
        shutdown(S,2);
#       alarm 0;
#print "---------------\n$res\n---------------\n";
        #my @tab=split(/\r\n/,$res);
        #pop @tab;
        #pop @tab;
        ($result)=($res =~ m/IDENT= (.*)\r\n/m);
#print "---------------\n$result\n---------------\n";
        return($result);
}