#!/usr/bin/perl #Simples Server konstrukt by FlorianL;) use strict; require 5.002; use warnings; use IO::Socket; use Carp; my $cfgfile = "serverconfig.cfg"; my $keyfile = ".key.file"; my ($port, $username, $choosed, $coderef, $crypted); sub logmsg {print "$0 $$: @_ at ", scalar localtime, "\n" } sub spawn; sub genpass { print ("\nGenerating KeyFile\nEnter your Password: "); chomp (my $password = ); my @chars = ("A" .. "Z"); my $salt = join("", @chars[ map {rand @chars } (1 .. 2) ]); $crypted = crypt("$password", "$salt"); open(KEYFILE,">$keyfile") or die "Error: Cant write the Keyfile"; print KEYFILE $crypted; close (KEYFILE); print ("\nHash = $crypted\n"); system("chmod 666 $keyfile"); print ("Keyfile saved to $keyfile!\nPermissions set to 666\nUpload it to your Clients now!\n"); } sub readconfig() { open(CONFIG,$cfgfile) or die "Error: Cant open $cfgfile"; my @config=; close(CONFIG); chomp($port = $config[0]); if ($port eq "") { die ("Error: No Port specified"); } chomp($username = $config[1]);        if ($username eq "") { die ("Error: No Username specified"); } } sub writeconfig() { print ("Config\n------\n"); print ("\nPort: "); my $port = ; if ($port =~ m/[a-z]+/) { die ("Port must be a number!"); }        print ("\nUsername: "); my $username = ; print ("Config written to $cfgfile\n"); my @config = ($port, $username,); open(CONFIG,">$cfgfile"); print CONFIG (@config); close (CONFIG); open(KEYFILE,">$keyfile"); if (-z "$keyfile") { print ("No KeyFile present, well we generate one now...\n"); genpass(); } else { print ("KeyFile allready present!\n"); } close(KEYFILE); } sub server() { readconfig(); my $proto = getprotobyname('tcp'); socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "FAILED: socket: $!"; setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)) || die "FAILED: setsockopt: $!"; bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "FAILED: bind: $!"; listen(SERVER, SOMAXCONN) || die "FAILED: listen: $!"; logmsg "Server started on Port $port"; my $waitedpid = 0; my $paddr; sub KILLER {         our $waitedpid = wait;         $SIG{CHLD} = \&KILLER;         logmsg "Killed $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&KILLER; for ($waitedpid = 0; ($paddr = accept(CLIENT,SERVER)) || $waitedpid; $waitedpid = 0, close CLIENT) { next if $waitedpid and not $paddr; my ($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); logmsg "Connection from",inet_ntoa($iaddr); spawn sub { print "CONNECT\n"; open(KEYFILE,$keyfile); my $crypt = ; close(KEYFILE); my $authresponse = ''; if ($authresponse eq $crypt) { print "AUTHED\n"; } else { print "DENIED\n"; } } } sub spawn { 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 "forked $pid"; return; } open (STDIN, "<&CLIENT") || die "cant dup client to stdin"; open (STDOUT, ">&CLIENT") || die "cant dup client ti stdout"; exit &$coderef(); } } sub help() { print ("Valid commandline Options are:\n"); print ("-config -Initiates Configuration\n"); print ("-printcfg -Print Config\n"); print ("-server -Starts the Server\n"); print ("-genpass -Generates a new keyfile \(1st-timers: Use -config instead!\)\n"); } main { $choosed = $ARGV[0]; if ($choosed eq '-config') {        writeconfig();        exit 0; } elsif ($choosed eq '-printcfg') {        readconfig(); print ("Port: $port"); print ("Username: $username");        exit 0; } elsif ($choosed eq '-genpass') {        genpass();        exit 0; } elsif ($choosed eq '-server') {        server();        exit 0; } else { help();        exit 0; } }