#!/usr/bin/perl -w
use strict ;

=head1 sched_xfer

A complete network scheduling system solution

=head2 DESCRIPTION

This program permit to get file from remote host. (small http webserver)

=head2 USAGE

    Usage : $0 [-h] [-t] [-c cfg]
	--help	     : print this help
	--test	     : test config
	--conf file  : use this config file
	
=head2 CONFIGURATION

    [slave]
    work_dir=/var/lib/wd

    [xfer]
    xfer_inet = plume			; interface to bind
    xfer_port = 5545		        ; tcp port to bind
    xfer_user = nobody			; running user
    xfer_group = nogroup		; running group


=head2 INSTALLATION

Complete installation details are in the README and README.conf files included
with the software. It works with the LWP library available on CPAN.

=head2 TODO

    o ACL
    o log
    o pesistent database

=head2 AUTHOR

(C) 2004-2005 Eric Bollengier

You may reach me through the contact info at eric@eb.homelinux.org

=head2 LICENSE

    sched_xfer, part of the network scheduling system (Sched)
    Copyright (C) 2004-2005 Eric Bollengier
        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 as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program 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 for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=cut

use Sched ;

my $VERSION = '$Id: sched_xfer,v 1.1 2005/04/05 19:45:18 mcgregor Exp $' ;

$ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin' ;

################################################################
# traitement de la ligne de commande

sub HELP_MESSAGE
{
    print "Usage : $0 [-h] [-t] [-c cfg]
    --help	     : print this help
    --test	     : test config
    --conf file      : use this config file
" ;
    exit (1) ;
}

my $file_conf = "$Sched::prefix_etc/slave.cfg" ;
my $test_conf ;
my $id_delete ;
my $id_add ;
my $id_file ;

use Getopt::Long ;

GetOptions("conf=s"   => \$file_conf,
           "help"     => \&HELP_MESSAGE,
           "test"     => \$test_conf,);

if (! -f $file_conf) {
    print "E : impossible d'ouvrir le fichier de conf $!\n" ;
    HELP_MESSAGE() ;
}

&Sched::init('xfer', $file_conf) ;

my %conf_default = ( xfer_inet => '0.0.0.0',
                     xfer_port => 5545,
                     xfer_user => 'nobody',
                     xfer_group => 'nogroup',
                     );

################################################################
# configuration

sub valid_conf
{

    my $ret = 1 ;
    if (!$Sched::cfg->SectionExists('xfer')) {
        print "E : impossible de trouver [xfer] dans $file_conf\n" ;
        return 0 ;
    }

    if (!$Sched::cfg->SectionExists('slave')) {
        print "E : impossible de trouver [slave] dans $file_conf\n" ;
        return 0 ;
    }

    if (!$Sched::cfg->val('slave', 'work_dir')) {
        print "E : impossible de trouver [slave]/work_dir dans $file_conf\n" ;
        return 0 ;
    }

    for my $k (keys %conf_default)
    {
        if (!Sched::cfg($k)) {
            print "E : attention [xfer]/$k non defini dans $file_conf\n";
            print "E : $k = $conf_default{$k}\n" ;
            $Sched::cfg->newval('xfer', $k, $conf_default{$k}) ;
        } else {
            print "D : $k = ", Sched::cfg($k), "\n" 
                if ($test_conf) ;
        }
    }

    $Sched::cfg->WriteConfig(\*STDOUT) if ($test_conf) ;

    return $ret ;
}

valid_conf() ;

exit 0 if ($test_conf) ;

################################################################
# gestion des ACL pour acceder aux fichiers

sub can_access
{
    my ($ip, $file) = @_ ;
    return 1 ;
}

################################################################
# ouverture du port d'ecoute

use HTTP::Daemon ;
use HTTP::Status;
use HTTP::Response ;
use HTTP::Message ;
use HTTP::Headers ;

my $d = HTTP::Daemon->new ( LocalPort =>  Sched::cfg('xfer_port'),
			    LocalAddr => Sched::cfg('xfer_inet'),
			    ReuseAddr => 1,
			    ) 
    || die "E : Impossible d'utiliser le port " . Sched::cfg('xfer_port') . " $!" ;

$SIG{TERM} = $SIG{INT} = sub { $Sched::log->write("I : recieve TERM") ; $d->close() ; exit (0) ;} ;

################################################################
# drop des privileges

sub drop_root
{
    my $gid = getgrnam(Sched::cfg('xfer_group')) ;

    if ($> == 0) {
	
	my $uid = getpwnam(Sched::cfg('xfer_user')) ;
	
	if ( not defined $uid) {
	    die "E : Impossible d'utiliser ". Sched::cfg('xfer_user') . " ($!)";
	}

	$> = $< =  $uid ;
    }

    $( = $) =  $gid if (defined $gid) ;
}

drop_root() ;

################################################################
# boucle de lecture du fichier de commande

use File::Basename qw/basename/;

sub xfer_list_dir
{
    my ($dir, $url) = @_ ;
    my $res = '';

    for my $e (<$dir/*>)
    {
	my $bn = basename($e) ;

	if (-d $e) {
	    $res .= "<a href='$url/$bn'>d $bn</a><br>\n" ;
	} elsif (-f $e) {
	    $res .= "<a href='$url/$bn'>f $bn</a><br>\n" ;
	}
    }
    return $res ;
}

################################################################
# traitement d'une requette cliente

use Cwd ;

sub xfer_client
{
    my ($c, $ip) = @_ ;
    my $r = $c->get_request ;
    
    return if (!$r) ;

    if (($r->method eq 'GET') 
	      and 
	     ($r->url->path =~ m!^/sched_job_dir/!))
    {
	my $job_dir = $Sched::cfg->val('slave', 'work_dir') ;

	my $p = $r->url->path ;
	$p =~ s!^/sched_job_dir/!$job_dir/! ;

	if ($^O eq 'cygwin') {
	    $SIG{__DIE__} = sub { $c->send_error(RC_NOT_FOUND) ; exit 0 ; } ;
	}

	$p = Cwd::abs_path($p) ;

	delete $SIG{__DIE__} ;

	if ($p !~ /^$job_dir/) {
	    $c->send_error(RC_UNAUTHORIZED) ;
	} else {
	    # verification host
	    if (-d $p) {
		my $h = HTTP::Headers->new('Content-Type' => 'text/html') ;

		my $r = HTTP::Response->new(HTTP::Status::RC_OK,
					    'OK', $h, 
      '<html><body>' . xfer_list_dir($p,$r->url->path) . '</body></html>') ;

		$c->send_response($r) ;
	    } elsif(-f $p) {
		$c->send_file_response($p);
	    } else {
		$c->send_error(RC_NOT_FOUND) ;
	    }
	}
    } else {
	$c->send_error(RC_NOT_FOUND) ;
    }

    $c->close;
}

$SIG{CHLD} = sub { waitpid(-1, 0) ; } ;

################################################################
# traitement de toutes les requettes

{ # main
    while (1) {
        my ($c, $ip) = $d->accept ;
	next unless ($c and $ip) ; # signal CHLD ?

	if(fork() == 0) {
	    xfer_client($c, $ip) ;
	    $d->close() ;
	    exit 0 ;
	}
	close($c) ;
    }
}

# EOF
