#!/usr/bin/perl
use strict;
use warnings;

# History:
# conray  - 19.02.2010 : 19:31 UTC - initial version with ping (-ping)
# betterworld - 19.02.2010 : 19:44 UTC - minor changes
# esskar  - 19.02.2010 : 20:27 UTC - changes on ping, and dump myself command (-dump)
# topeg  - 19.02.2010 : 00:02 UTC - addded mirror
# Kalle - 01.03.2010 - added technology assimilation automation
# conray - 02.02.2010 21:07 - added Helpfunktion (-help) and changes on Ping-Parameter
# conray - 03.02.2010 19:28 - added Password-Generator (-pwgen)
# conray - 08.03.2010 21:35 - added print location (-whereami)
# steferbo - 08.03.2010 23:10 - added get country from ip (-get_country)
# topeg - 09.03.2010 23.46 - changed to GetOpt::Long, adapt assimilate ping, pwgen and get_country, added dummy (--dummy), added truemirror (--truemirror <file|->)

use Getopt::Long;

use FindBin;
use Net::Ping;
use LWP::UserAgent;
use HTTP::Cookies;
use File::Basename;

#EierlegendeWollMilchSau.pl
my %opts=();
my @runn=();
my %commands=(
########################################################################
########################################################################
#_______________________________________________________________________
'dummy' => [
"dummy\t\tDoing nothing!",
sub {
  # empty.
}],

#_______________________________________________________________________
'help|h' => [
"help\t\tprint out this usagetext",
sub{
  HELP();
},
'runn now'],

#_______________________________________________________________________
'ping=s,range=i' => [
"ping <ip> [--range=<range>]\t\ttrys to ping an ip or an range of ip addresses.",
sub
{
  my ($ip,$till) = @_;
  my @r = split(/\./, $ip);

  $till=$r[3] unless(defined($till));

  my $until = $till + 1;
  while ($r[3] < $until )
  {
    $ip = join '.', @r;
    my $ping = Net::Ping->new('icmp', 1, 64 );
    print "$ip " . ($ping->ping($ip) ? 'online' : 'offline') . "\n";
    $r[3]++;
  }
}],

#_______________________________________________________________________
'dump' => [
"dump\t\tdumps itself to STDOUT",
sub
{
  my $path = "$FindBin::Bin/$FindBin::Script";
  open(my $myself, "< $path") or die "Unable to open myself ($path): $!";
  while(<$myself>) { print $_; }
  close $myself;
}],

#_______________________________________________________________________
'devil' => [
"devil\t\tDon't try that",
sub
{
  print "So long, and thanks for all the fish.\n";
  unlink $0 or die "Will not stop :'-(\n";
}],

#_______________________________________________________________________
'mirror=s' => [
"mirror <file|->\t\tmirror file or STDIN",
sub
{
  my $fh=\*STDIN;
  my $file=shift;
  open($fh,'<',$file) || die("ERROR open $file ($!)") if($file && $file ne '-');
  chomp($_) && print reverse($_)."\n" while(<$fh>);
  close($fh);
}],

#_______________________________________________________________________
'truemirror=s' => [
"truemirror <file|->\t\tmirror file or STDIN",
sub
{
  my $fh=\*STDIN;
  my $file=shift;
  open($fh,'<',$file) || die("ERROR open $file ($!)") if($file && $file ne '-');
  my @lines=();
  my $length;
  while (my $line=<$fh>)
  {
    $length=length($line) if(!defined($length) || $length<length($line));
    chomp($line);
    $line=reverse($line);
    $line=~y/()[]{}\\\/`´<>/)(][}{\/\\´`></;
    push(@lines,$line);
  }
  printf ("%${length}s\n",$_) for(@lines);
  close($fh);
}],

#_______________________________________________________________________
'assimilate=s' => [
"assimilate newparam.pl\t\tassimilate more perl code into this script",
sub
{
  my $newtechsource=shift;
  my $borgtechnology;
  my $assimilationspace;
  my $newtechnology;
  my ($newcmdname)=split(/\./,$newtechsource,0);
  $newcmdname=~y/=|!?//d;
  $newcmdname=~s/\s+/_/s;
  my ($borgbase,$borgpath)=fileparse($0);
  my $newborgtechnology="${borgpath}Neue$borgbase";
  if (open($borgtechnology,'<',$0)) {
    if (open($assimilationspace,'>',$newborgtechnology)) {
      if (open($newtechnology,'<',$newtechsource)) {
        while(<$borgtechnology>) {
          if (/^# <-- don't touch this/) {
             my $thisline=$_;
             print "Assimiliere neue Technologie...\n";
             print $assimilationspace qq!
#_______________________________________________________________________
'$newcmdname' => [
"$newcmdname\\t\\t assimilated weird stuff",
sub {
!;
             while(<$newtechnology>) {
               next if (/^#!|^use strict;|^use warnings;/);
               print $assimilationspace $_;
             }
             close($newtechnology);
             print $assimilationspace qq!
},
'runn now'],

$thisline!;
          }
          else {
            print $assimilationspace $_;
          }
        }
        close($borgtechnology);
        if (close($assimilationspace)) {
          print "Widerstand war zwecklos!\nNeue Technologie einsetzbar: Neue$borgbase --$newcmdname\n";
        }
        else {
          print "Aktivierungssequenz ungültig. Assimilation abgebrochen.\n";
        }
      }
      else {
        print "Neue Technologie kann nicht assimiliert werden. Abbruch der Assimilation\n";
      }
    }
    else {
      print "Fluktuation im temporären Raum-/Zeitgefüge. Abbruch der Assimilation.\n";
    }
  }
  else {
    print "Wo sind wir ? Es ist so....leise. Bring uns nach Hause!\n";
  }
}],

#_______________________________________________________________________
'pwgen=i' => [
"pwgen\t\tgenerates an (secure) password",
sub
{
  my $input=shift;
  unless($input)
  {
    print "How much positions your password should have?\n";
    print "Note: Secure passwords have 10 positions as minimum \n";
    $input=<STDIN>;
    chomp $input;
  }
  $input=~s/[^\-\d].+$//;
  $input=abs($input);

  my @bletters = ("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z");
  my @sletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z");
  my @numbers = ("1", "2", "3", "4", "5", "6", "7", "8", "9", "0");
  my @special = ("!", "\.", "\$", "\%", "\&", "?", "\/", "\\", "\,", "-", "_", "\#", "\*", ":", "(", ")", "=", "+", "<", "§", "[", "]", "\;");

  my $pw='';
  while (length($pw) != $input) {
     my $n1 = int(rand(26));
     my $n2 = int(rand(26));
     my $n3 = int(rand(10));
     my $n4 = int(rand(23));
     my $z = int(rand(4));
     if ($z == 0) {
        $pw = $pw . $bletters[$n1]; }
     elsif ($z == 1) {
        $pw = $pw . $sletters[$n2]; }
     elsif ($z == 2) {
        $pw = $pw . $numbers[$n3]; }
     elsif ($z == 3) {
        $pw = $pw . $special[$n4]; }
     else {
        print "There is bug";
        exit; }
     }
  print "The generated Password is: $pw \n";
}],

#_______________________________________________________________________
'whereami' => [
"whereami\t\tprint out the filelocation",
sub
{
  print __FILE__."\n";
}],

#_______________________________________________________________________
'get_country=s' => [
"get_country <ip>\t\tsingle-host 32bit decimal",
sub
{
  my $ip = shift;
  my $line=""; my $country=""; my $out="IP: $ip is non-registered";
  my $whois="http://www.utrace.de/whois/";
  my $hol=$whois.$ip;
  my $html=stuff($hol);
    $html =~ s/<([^>]|\n)*>//mig;
    $html =~ s/&nbsp;//mig;
    (my @text)=split(/\n/,$html);
        foreach $line (@text){
                      if( $line =~ /country:/ig ){
                      $line =~ s/\s//ig;
      (my $nix, $country)=split(/:/,$line);
                      $out="IP: $ip has country-code: $country";
                      goto ELMS;
          } # end if
         } # end foeach
  ELMS:
  print $out;
}],

# <-- don't touch this

########################################################################
########################################################################
);

for(keys(%commands))
{
  my $opt=$_;
  my $cmdref=$commands{$_}[1];
  my $runn_mod='runn last';
  $runn_mod=lc($commands{$_}[2]) if(exists($commands{$_}[2]));
  my @olist=split(/\s*,\s*/s,$opt);

  if($runn_mod eq 'runn now')
  {
    for(@olist)
    { $opts{$_}=sub{ $cmdref->(pop(@_)); } }
  }
  elsif($runn_mod eq 'runn first')
  {
    for my $pos (0..$#olist)
    {
      die("no option in $opt position $pos\n") unless($olist[$pos]);
      $opts{$olist[$pos]}=sub{ add_cmd($opt,pop(@_),$pos,1); }
    }
  }
  elsif($runn_mod eq 'runn last')
  {
    for my $pos (0..$#olist)
    {
      die("no option in $opt position $pos\n") unless($olist[$pos]);
      $opts{$olist[$pos]}=sub{ add_cmd($opt,pop(@_),$pos,0); }
    }
  }
  else
  { die(qq#Can't interpret runn modifier "$runn_mod" \n#); }
}
my $ok=GetOptions(%opts);

HELP(@ARGV) if(@ARGV);
HELP(0) unless($ok);

for my $cmd (@runn)
{
  my $name=shift(@$cmd);
  $commands{$name}->[1]->(@$cmd);
}

########################################################################
# FUNCTIONS ############################################################
########################################################################

sub stuff {
  my $url=shift;
  my $agent="Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.9.0.18) EierlegendeMilchSau/1.0.0";
  my $cookie = HTTP::Cookies->new;

  my $req = HTTP::Request->new(GET => $url);
  $req->header('Referer', '');
  $req->header('Accept', 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8');
  $req->header('Accept-Language', 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3');
  $req->header('Accept-Charset', 'ISO-8859-1,utf-8;q=0.7,*;q=0.7');
  $req->header('Keep-Alive', '115');
  $req->header('Cache-Control', 'max-age=0');
  my $browser = LWP::UserAgent->new;
  $browser -> agent($agent);
  $browser -> cookie_jar($cookie);
  my $res = $browser->request($req);
  my $stuff = $res->content;
  return ($stuff);
}# end sub stuff


sub add_cmd
{
  my $name=shift;
  my $opt=shift;
  my $pos=shift || 0;
  my $first=shift || 0;
  for my $ref (@runn)
  {
    if($ref->[0] eq  $name)
    {
      $ref->[$pos+1]=$opt;
      return;
    }
  }

  if($first)
  { unshift(@runn,[$name,$opt]); }
  else
  { push(@runn,[$name,$opt]); }
}

sub HELP{
  my @errors=@_;

  my @list=();
  my $length_first;
  my $length_second;
  for my $cmd (sort keys(%commands))
  {
    $length_first=length($cmd) if(!defined($length_first) || $length_first<length($cmd));
    my ($cmdtxt,$desctxt)=split("\t\t",$commands{$cmd}->[0],2);
    $desctxt='' unless($desctxt);
    $cmdtxt='' unless($cmdtxt);
    $length_second=length($cmdtxt) if(!defined($length_second) || $length_second<length($cmdtxt));
    push(@list,[$cmd,$cmdtxt,$desctxt]);
  }

  my $oh=\*STDOUT;
  $oh=\*STDERR if @errors;

  if($errors[0])
  {
    for(@errors)
    { print $oh "Unknown option: $_\n"; }
  }

  print $oh "usage: $0 <parameters>\n\n";
  print $oh "parameters:\n";

  for(@list)
  { printf $oh "  %-${length_first}s => --%-${length_second}s %s\n", @$_; }

  print $oh "\n";
  exit(@errors?1:0);
}

__END__