#!/usr/bin/perl -w

###########################################################################
#
# Baracus build and boot management framework
#
# Copyright (C) 2010 Novell, Inc, 404 Wyman Street, Waltham, MA 02451, USA.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Artistic License 2.0, as published
# by the Perl Foundation, or the GNU General Public License 2.0
# as published by the Free Software Foundation; your choice.
#
# 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.  Both the Artistic
# Licesnse and the GPL License referenced have clauses with more details.
#
# You should have received a copy of the licenses mentioned
# along with this program; if not, write to:
#
# FSF, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110, USA.
# The Perl Foundation, 6832 Mulderstraat, Grand Ledge, MI 48837, USA.
#
###########################################################################

use strict;
use warnings;

use Getopt::Long;
use Time::localtime;
use LWP;

use lib "/usr/share/baracus/perl";

use BaracusConfig qw( :vars );
use BaracusSYSLOG qw( :subs );
use SqlTFTPd qw(%OPCODES);
use SqlFS;

my $debug = 0;
my $now;

$debug = 1 if ( defined $baVar{bdoptions} and $baVar{bdoptions} =~ m|debug| );

# setup log file with permissions that will allow cgi access
my $logfile = "$baDir{'logs'}/baracusd";
my $logger="wwwrun";
my $loguid;

open(STDOUT, ">>$logfile") or die "Unable to open $logfile: $!";
open(STDERR, ">>$logfile") or die "Unable to open $logfile: $!";

unless ($loguid = (getpwnam($logger))[2]) {
    die "Attempt to run server as non-existent or super user\n";
}
chown $loguid, 100, $logfile or die $!;

&config_syslog();

# get baracus id information
my $user = "baracus";
my $uid;
unless ($uid = (getpwnam($user))[2]) {
    die "Attempt to run server as non-existent or super user\n";
}

# create instance of TFTP server
my $listener = SqlTFTPd->new( 'Timeout' => 10, 'debug' => $debug )
    or die SqlTFTPd->error;

unless( $listener->open() ) {
    print STDOUT "[" . ctime() ."] baracusd unable to listen on tftp port: ", $@, "\n";
    print STDOUT "[" . ctime() ."] Try shutting down other possible tftp servers first:\n\n",
        "\tservice atftpd stop\n",
        "\tchkconfig atftpd off\n\n",
        "Or disabling the xinetd based 'tftp' service:\n\n",
        "\tchkconfig tftp off\n\tservice xinetd restart\n\n";
    my $diestr = sprintf "Unable to open port for TFTP connections: ", $@, "\n",
        "please refer to $baDir{'logs'}/baracusd for details.\n";
    print STDERR $diestr;
    die "$diestr\n";
}

$now = ctime();

unless ( &fuse_is_loaded() ) {
    if ( &fuse_load() ) {
        # sub is system call non-zero on error
        print STDOUT "[${now}] Error:  unable to load 'fuse' module. Try with:  modprobe fuse\n";
    } else {
        print STDOUT "[${now}] module fuse now loaded.\n";
    }
}

print STDOUT "[${now}] baracusd launched with uid: $>\n";

# set the effective id to baracus
my $suid = $>;
$> = $uid;

# delayed printing to switch to non-root asap
printf STDOUT "[${now}] SqlTFTPd listener is bound to %s:%d\n",
    $listener->{'LocalAddr'} ? $listener->{'LocalAddr'} : "'any address'",
    $listener->{'LocalPort'};

print STDOUT "[${now}] baracusd now running with uid: $>\n";

# create and/or connect to our database to serve up TFTP files
my $dbname = "sqltftp";
my $dbsource = "DBI:Pg:dbname=$dbname;port=5162";
print STDOUT "[debug] dbsource   $dbsource\n" if $debug;

my $sqlfsOBJ = SqlFS->new( 'DataSource' => "$dbsource",
                           'User' => "baracus",
                           'debug' => "$debug" )
    or die "Unable to create new instance of SqlFS\n";

$listener->setSqlFSHandle( $sqlfsOBJ );

# load any missing required files
my @requiredfiles = ( "$baDir{'data'}/data/pxelinux.0",
                      "$baDir{'data'}/data/sanboot.c32",
                      "$baDir{'data'}/data/chain.c32",
                      "$baDir{'data'}/data/gpxe_baracus.0",
                      "$baDir{'data'}/data/linux.baracus",
                      "$baDir{'data'}/data/initrd.baracus",
                      "$baDir{'data'}/data/linux-xen.baracus",
                      "$baDir{'data'}/data/initrd-xen.baracus",
                     );

foreach my $requiredfile ( @requiredfiles ) {
    unless ( $sqlfsOBJ->find( $requiredfile ) ) {
        $now = ctime();
        unless ( -f $requiredfile) {
            my $diestr = sprintf "[${now}] required file not found: $requiredfile";
            print STDERR $diestr;
            die "$diestr\n";
        }
        print STDOUT "[${now}] missing required - now adding $requiredfile\n";
        if ( ($requiredfile =~ m/initrd.baracus/) and
             (-f "$baDir{root}/.ssh/workload_ssh_done") ) {
            unlink "$baDir{root}/.ssh/workload_ssh_done";
            print STDOUT "[${now}] forcing reload of ssh key in initrd.barcus\n";
        }
        $sqlfsOBJ->store( $requiredfile );
    }
}

# as root - make sure initrd.baracus has SSH keys required
$> = $suid;
system("$baDir{'data'}/scripts/baracusManageWorkloadSSH");
$> = $uid;

# perpetually serve up files from SqlFS database via TFTP

# hash ref of ips that have been denied pxe 01-<mac> disabled entries
# freaking winpe arch and windows install arch must match
my $winpefiles = "BCD  bootmgr.exe  boot.sdi  boot.wim";
my $iparchmap = {};

print STDOUT "[" . ctime() ."] ready to serve tftp files\n";

while (1) {
    # wait for any request (RRQ or WRQ)
    if (my $request = $listener->waitRQ()) {
        # process request and be done if validateURL
#        unless ( $dovalidate && &validateURL( $request ) ) {

        # upcase MAC portion of pxeboot 01-<mac> file
        # and extract ip/arch and mangle filename with arch for win
        &upcasepxefilename( $request );


        $SIG{CHLD} = 'IGNORE';  # so we don't create zombies

        my $child = fork();

        if ( $child ) {
#            print "forked pid $child for $request->{'_REQUEST_'}{'FileName'}\n";
            ;
        }
        elsif ( ! $child ) {
            $sqlfsOBJ->clone_dhb_for_child();
            $now = ctime();
            printf "[${now}] %s Received %s for file '%s'\n",
                $request->{'_REQUEST_'}{'PeerAddr'},
                    $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}},
                        $request->{'_REQUEST_'}{'FileName'};

            # if the request is for menu.lst.mac then grab data from fileDB
           if ( $request->{'_REQUEST_'}{'FileName'} =~ m|menu.lst.01((([0-9a-fA-F]){2}){6})$| ) {
               unless ( $sqlfsOBJ->find($request->{'_REQUEST_'}{'FileName'}) ) {
                   my $rmac = $1;
                   my @parts = split( '', $rmac );
                   my $fmac = sprintf '%X%X:%X%X:%X%X:%X%X:%X%X:%X%X', map hex, @parts;

                   my $ua = LWP::UserAgent->new( );
                   my $response = $ua->get("http://$baVar{serverip}/ba/menu.lst?mac=$fmac");
                   $sqlfsOBJ->storeScalar( $request->{'_REQUEST_'}{'FileName'}, \$response->content, '' );
               }
            }
            my $status = $request->processRQ( );
            if ( $status ) {
                $now = ctime();
                printf STDOUT "[${now}] %s Success  %s for file '%s' done\n",
                    $request->{'_REQUEST_'}{'PeerAddr'},
                        $OPCODES{$request->{'_REQUEST_'}{'OPCODE'}},
                            $request->{'_REQUEST_'}{'FileName'};

                if ( $request->{'_REQUEST_'}{'FileName'} =~ m|boot.wim| ) {
                    # on successful deliver of winpe env nuke ip/arch mapping
                    delete $iparchmap->{ $request->{'_REQUEST_'}{'PeerAddr'}};
                }
                # remove the temp menu.lst.<mac> in fileDB
                if ( $request->{'_REQUEST_'}{'FileName'} =~ m|menu.lst.01((([0-9a-fA-F]){2}){6})$| ) {
                    $sqlfsOBJ->remove( $request->{'_REQUEST_'}{'FileName'} );
                }
            } else {
                print STDOUT "[${now}] " . $request->{'_REQUEST_'}{'PeerAddr'} . " : " . SqlTFTPd->error;
            }

            # exit the forked proc
            exit 0;
        }
        else {
            print "Trouble forking\n";
        }
    }
}

exit 0;

die "DOES NOT EXECUTE";

###########################################################################

sub config_syslog
{
    my $logconf="/etc/syslog-ng/syslog-ng.conf";
    my $armorconf="/etc/apparmor.d/sbin.syslog-ng";
    my $logpath = "$baDir{'logs'}/remote";

    unless ( -d $logpath ) {
        mkdir "$logpath", 0755
            or die ("Cannot create $logpath: $! \n");
    }

    unless ( -f $logconf ) {
        return;
    }

    if ($baVar{rlogging} eq "yes") {
        print STDOUT "[" . ctime() ."] Enabling remote logging support in syslog-ng.conf\n";
        if ( enable_remote_logging( $logpath,
                                    $logconf,
                                    $baVar{serverip} )) {
#            system("rcsyslog restart");
            system("rcsyslog status || rcsyslog restart");
        } else {
            print "[". ctime() ."] ". BaracusSYSLOG::error();
        }

        unless ( -f $armorconf ) {
            return;
        }

        if ( enable_apparmor_logging( $logpath,
                                      $armorconf ) ) {
#            system("rcapparmor restart");
            system("rcapparmor status || rcapparmor restart");
        } else {
            print "[". ctime() ."] ". BaracusSYSLOG::error();
        }
    } else {
        print STDOUT "[" . ctime() ."] Disabling remote logging support in syslog-ng.conf\n";
        if ( disable_remote_logging( $logconf ) ) {
#            system("rcsyslog restart");
            system("rcsyslog status || rcsyslog restart");
        } else {
            print "[". ctime() ."] ". BaracusSYSLOG::error();
        }

        unless ( -f $armorconf ) {
            return;
        }

        if ( disable_apparmor_logging( $logpath, $armorconf ) ) {
#            system("rcapparmor restart");
            system("rcapparmor status || rcapparmor restart");
        } else {
            print "[". ctime() ."] ". BaracusSYSLOG::error();
        }
    }
}

# upcasepxefilename - overloaded and thus now misnamed
# upcase 01-macs if requested (old and likely obsolete)
# also removes pathing
# and does some arch manipulation of some requested files

sub upcasepxefilename {
    my $request = shift;

    if ( $request->{'_REQUEST_'}{'FileName'} =~ m|01-((([0-9a-fA-F]){2}-?){6})| ) {
        $request->{'_REQUEST_'}{'FileName'} =~ s|^([^/]*)/||; # match prefix and rm
        $request->{'_REQUEST_'}{'FileName'} =~ tr|a-z|A-Z|;   # upcase
        $request->{'_REQUEST_'}{'FileName'} =
            "$1/" . $request->{'_REQUEST_'}{'FileName'}; # put prefix back
    } elsif ($request->{'_REQUEST_'}{'FileName'} =~ m|(.*)/startrom.0|) {
        my $arch = $1;
        $iparchmap->{$request->{'_REQUEST_'}{'PeerAddr'}} = $arch;
        print STDOUT "[" . ctime() ."] remaping $request->{'_REQUEST_'}{'FileName'} to startrom.0-${arch}\n";
        $request->{'_REQUEST_'}{'FileName'} = "startrom.0-${arch}";
    } else {
        $request->{'_REQUEST_'}{'FileName'} =~ s|.*\\||;
        $request->{'_REQUEST_'}{'FileName'} =~ s|^\\||;

        if ( $winpefiles =~ m|\b$request->{'_REQUEST_'}{'FileName'}\b|) {
            if ( defined $iparchmap->{ $request->{'_REQUEST_'}{'PeerAddr'} } )
            {
                my $arch = $iparchmap->{ $request->{'_REQUEST_'}{'PeerAddr'} };
                print STDOUT "[" . ctime() ."] remaping $request->{'_REQUEST_'}{'FileName'} to $request->{'_REQUEST_'}{'FileName'}-${arch}\n";
                $request->{'_REQUEST_'}{'FileName'} .= "-${arch}";
            }
        }
    }
}

sub fuse_is_loaded
{
    return (! system("lsmod | grep fuse &> /dev/null"));
}

sub fuse_load
{
    return system("modprobe fuse &> /dev/null");
}

die "ABSOLUTELY DOES NOT EXECUTE";

__END__
