
- `wallet/wallet.cgi`:
```perl
#!/usr/bin/perl

# FCC Local Wallet Server
use lib qw(../install/modules);
use strict;
no strict 'refs';
use warnings;no warnings qw<uninitialized>;
use Time::HiRes qw(usleep gettimeofday);
use Crypt::Ed25519;
use Browser::Open qw(open_browser);
use gfio 1.11;
use gserv 4.3.2 qw(wsmessage broadcastfunc);
use gclient 8.1.2;
use FCC::global 2.2.1;
use FCC::miner 1.1.3;
use FCC::wallet 2.1.4 qw(validwallet validwalletpassword walletisencoded newwallet loadwallets savewallet savewallets);
use FCC::leaf 2.1.1 qw(startleaf leafloop closeleaf);
use gerr qw(error);
use JSON;

my $DEBUG = 1;
my $INIT = 0;
my $SERVER;
my $POOL;
my $WEBSITEINIT=0;
my $FCCSERVER='https://factorialcoin.nl:'.$FCCSERVERPORT;
my @NODES=(); my $NODENR=0; my $WLIST=[]; my $PASS;
my $TRANSCOUNT = 0;
my $MINER;
my $MINING=0;
my $MINEDATA={ coincount => 0 };
my $MINFHASH=undef;
my $MAXFHASH=undef;
my $MINERWALLET="";
my $POWERDOWN=0;
my $MINERDISCON=0;

my $VERSION = "010104";

################################################################################
###### Use the file trusted.nodes to force connecting to trusted nodes #########

my $TRUSTEDNODES=(-e "trusted.nodes" ? decode_json(gfio::content("trusted.nodes")) : []);
my $FORCENODE; if($#$TRUSTEDNODES>-1){ $FORCENODE=$TRUSTEDNODES->[int(rand()*(1+$#$TRUSTEDNODES))] }

################################################################################
# Local Wallet Listen Port
my $PORT =
  $ARGV[0] && $ARGV[0] =~ /[0-9]+/ ? $ARGV[0] : 
  -e "wallet.port" ? gfio::content("wallet.port") : 
  5115;
################################################################################
# Local Wallet Chat Nick & Ident
my $NICKIDENT;
if (-e "nickident.chat") {
  $NICKIDENT=decode_json(gfio::content("nickident.chat"));
} else {
  $NICKIDENT={}
}
################################################################################

################################################################################
# Signaling 

$SIG{'INT'}=\&intquit;
$SIG{'TERM'}=\&termquit;
$SIG{'PIPE'}=\&sockquit;
$SIG{__DIE__}=\&fatal;
$SIG{__WARN__}=\&fatal;

#versionCheck();

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

sub fatal {
  print "!!!! FATAL ERROR !!!!\n",@_,"\n";
  killserver("Fatal Error",1); error(@_)
}
sub intquit {
  killserver('130 Interrupt signal received'); exit
}  
sub termquit {
  killserver('108 Client forcably killed connection'); exit
}
sub sockquit {
  killserver("32 TCP/IP Connection error"); exit
}

###### Development Wallet Updater by SkyDrive & OnEhIppY #######################

sub versionCheck {
  my $github={base => "https://raw.githubusercontent.com/FactorialCoin/base/master"};
  $github->{dev}="$github->{base}/FCC/Wallet/wallet.dev";
  my $fil = ['wallet.cgi','wallet.js','wallet.htm','wallet.css','image/clipboard.png','image/del.png','image/favicon-16.png','image/favicon-32.png','image/fccico.png','image/fcclogo.png','image/pause.png','image/pickaxe.gif','image/powerdown.png','image/save.png','image/start.png'];
  my $fccversion = get("$github->{base}/version.txt"); $fccversion=~s/[^0-9]//gs;
  print "** Github FCC base Version is: $fccversion\n";
  my $version = get("$github->{dev}/version.txt"); $version=~s/[^0-9]//gs;
  my ($MAIN, $MAJOR, $MINOR) = (substr($VERSION,0,2),substr($VERSION,2,2),substr($VERSION,4,2));
  my ($main, $major, $minor) = (substr($version,0,2),substr($version,2,2),substr($version,4,2));
  print "** Our Wallet Version is: $MAIN.$MAJOR.$MINOR\n";
  print "** Github FCC/Wallet/wallet.dev Version is: $main.$major.$minor\n";
  my $upd=0;
  if( $version > $VERSION ){ # ipv if( ($main > $MAIN) || ($major > $MAJOR && $main >= $MAIN) || ($minor > $MINOR && $major >= $MAJOR && $main >= $MAIN) ){
    print "** Updating to Version $VERSION to new Version $version .. ** \n";
    my $up=0;
    for my $f (@$fil) {
      $up++;
      print "** Updating ($up of ".(1+$#{$fil}).": $f ".(" "x16)."\r";
      if($f =~ /image\//){
        if(!-e $f){
          my $d=get("$github->{dev}/$f");
          if($d) { gfio::content($f,$d) }
        }
      } else {
        my $d=get("$github->{dev}/$f");
        if($d) { gfio::content($f,$d) }
      }
    }
    gfio::content("wallet.updated",$version);
    $upd++;
  }else{
    # check for missing files after update (new images)
    my $mss=0;
    for my $f (@$fil) { if (!-e $f) {
      if(!$mss){ $mss=1; print "** Updating missing files or images of Current Version $VERSION .. ** \n" }
      print "** Updating ($mss of ".(1+$#{$fil}).": $f ".(" "x16)."\r";
      $upd++; my $d=get("$github->{dev}/$f"); if($d){ $mss++; gfio::content($f,$d) } 
    } }
  }
  if($upd){
    print "\n ** 5 ** Please Restart your wallet.. ** \r";
    for(my $s=5;$s>0;$s--){ print " ** $s \r"; usleep(1000000) }
    exit
  }
}

sub get { 
  my $req=gclient::website(@_);
  if($req->{error}){
    print "\nError requesting : $_[0]\n$req->{error}\n\n";
    return
  }
  return $req->content()
}

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

sub killleaves {
  my ($client,$message) = @_;
  if ($client->{fcc}{leaf}) {
    $client->{fcc}{leaf}->wsquit($message)
  }
  if ($client->{fcc}{miner}) {
    $client->{fcc}{miner}->wsquit($message)
  }
}

sub killserver {
  if ($SERVER) {
    broadcastfunc($SERVER,\&killleaves,$_[0]);
    print "Terminating FCC Local Wallet Server .. \n";
    $SERVER->quit($_[0]);
  }
  if ($MINER) { $MINER->closeleaf() }
  if (!$_[1]) { exit }
}

sub quitleaf {
  my ($client) = @_;
  if ($client->{fcc}){
    if($client->{fcc}{leaf}) {
      closeleaf($client->{fcc}{leaf})
    }
    elsif($client->{fcc}{miner}) {
      closeleaf($client->{fcc}{miner})
    }
  }
}

initfcc();
print "Starting FCC localhost Wallet Server .. \n";
$SERVER=gserv::init(\&handle,\&loop);
$SERVER->{name}="FCC Local Wallet Server v1.0";
$SERVER->{server}{port}=$PORT;
$SERVER->{allowedip}=['127.0.0.1'];
$SERVER->{verbose}=0;
$SERVER->start(1,\&serverloop);
if ($SERVER->{error}) {
  print "Error starting server: $SERVER->{error}\n"
} else {
  print "Server terminated o.k.\n"
}
exit;

sub loopclient {
  my ($client) = @_;
  if ($client->{fcc}) {
    if ($client->{fcc}{connectnode}) {
      connecttonode($client)
    } elsif ($client->{fcc}{leaf} && $client->{fcc}{leafready}) {
      my $leaf=$client->{fcc}{leaf};
      if ( $#{$client->{fcc}{jobs}} >=0 ) {        
        my $job=shift @{$client->{fcc}{jobs}};
        if ($job->{command} eq 'balance') {
          if ($job->{time}) {
            my $ctm=gettimeofday();
            if ($ctm-$job->{time} < 10) {
              unshift @{$client->{fcc}{jobs}},$job;
              return
            }
          }
          $leaf->balance($job->{wallet})
        } elsif ($job->{command} eq 'transfer') {
          $leaf->transfer($job->{pubkey},$job->{change},$job->{outlist})
        } elsif ($job->{command} eq 'startminer') {
          print "Starting Miner\n";
          if(!$MINING || !$MINER || $MINERDISCON){
            $MINERDISCON=0;
            print "Opening Node Connection\n";
            $MINER=startleaf($client->{fcc}{leafip},$client->{fcc}{leafport},\&slaveminercall,0,1);
          }
          if ($MINER->{error}) {
            print " ! Error starting miner - $MINER->{error}\n"
          } else {
            $MINER->{client}=$client;
            print " * Miner sucessfully started .. may the FCC be with you ;)\n"
          }
        }
      }
    } else {
      # unexpected fallback
      connecttonode($client)
    }
  }
}

sub serverloop {
  if (!$WEBSITEINIT) {
    print " * Opening wallet website\n";
    eval("open_browser(\"http://127.0.0.1:$PORT\");");
    $WEBSITEINIT=1;
    print " * Browser Opened\n";
  }
  leafloop();
  broadcastfunc($SERVER,\&loopclient);
  if ($MINING) {
    my $tb=1;
    my $lsz=1000;
    for (my $i=0;$i<$lsz;$i++) {
      mineloop()
    }
    my $tm=gettimeofday();
    $MINEDATA->{fhash}+=$lsz;
    my $bnr=int (($tm-$MINEDATA->{minestart})/$tb);
    if ($bnr != $MINEDATA->{timeblock}) {
      $MINEDATA->{timeblock}=$bnr;
      my $hr=int ($MINEDATA->{fhash} / $tb);
      if(!defined $MINFHASH || $MINFHASH > $hr){ $MINFHASH=$hr }
      if(!defined $MAXFHASH || $MAXFHASH < $hr){ $MAXFHASH=$hr }
      my $done=$MINEDATA->{hashtot}+=$MINEDATA->{fhash};
      $done=int (10000 * $done / $MINEDATA->{diff}) / 100;
      if ($MINER->{client}) { wsmessage($MINER->{client},"miner Speed: $hr Fhash/sec ($done %)") }
      print " Speed: $hr Fhash/sec ($done %) $MINER->{client} \r";
      $MINEDATA->{fhash}=0
    }
  }
  if($POWERDOWN){
    leafloop();
    if($POWERDOWN > 100){
      exit 1;
    }
    $POWERDOWN++
  }
  usleep($MINING ? 100:10000);
}

sub challenge {
  my ($data) = @_;
  $MINEDATA=$data; $MINING=1;
  $MINEDATA->{minestart}=gettimeofday(); $MINEDATA->{timeblock}=0; $MINEDATA->{fhash}=0; $MINEDATA->{hashtot}=0;
  if ($MINEDATA->{hints}) {
    $MINEDATA->{hints}=perm($MINEDATA->{hints},int(rand(fac(length($MINEDATA->{hints})))));
    $MINEDATA->{hintpos}=0;
    $MINEDATA->{tryhint}=substr($MINEDATA->{hints},0,1);
    if ($MINER->{client}) { wsmessage($MINER->{client},"miner Trying suggestion $MINEDATA->{tryhint}") }
    print " * Trying suggestion $MINEDATA->{tryhint}     \n";
  } else {
    $MINEDATA->{tryhint}=""
  }
  $MINEDATA->{tryinit}="";
  for (my $i=0;$i<$MINEDATA->{length};$i++) {
    if ($MINEDATA->{tryhint} ne chr(65+$i)) {
      $MINEDATA->{tryinit}.=chr(65+$i)
    }
  }
  $MINEDATA->{trymax}=fac(length($MINEDATA->{tryinit}));
  $MINEDATA->{try}=int rand($MINEDATA->{trymax});
  $MINEDATA->{trystart}=$MINEDATA->{try};
}

sub mineloop {
  if (!$MINING) { usleep(10000); return }
  my $suggest=$MINEDATA->{tryhint}.perm($MINEDATA->{tryinit},$MINEDATA->{try});
  if (minehash($MINEDATA->{coincount},$suggest) eq $MINEDATA->{challenge}) {
    # found the solution!
    my $solhash=solhash($MINERWALLET,$suggest);
    print " **!! SOLUTION !!** $suggest\n";
    $MINER->solution($MINERWALLET,$solhash);
    $MINING=0; return
  }
  $MINEDATA->{try}++;
  if ($MINEDATA->{try} >= $MINEDATA->{trymax}) {
    $MINEDATA->{try}=0
  }
  if ($MINEDATA->{try} == $MINEDATA->{trystart}) {
    $MINEDATA->{hintpos}++;
    if ($MINEDATA->{hintpos} < length($MINEDATA->{hints})) {
      $MINEDATA->{tryhint}=substr($MINEDATA->{hints},$MINEDATA->{hintpos},1);
      if ($MINER->{client}) { wsmessage($MINER->{client},"miner Trying suggestion: $MINEDATA->{tryhint}") }
      print " * Trying suggestion: $MINEDATA->{tryhint}   \n";
      $MINEDATA->{tryinit}="";
      for (my $i=0;$i<$MINEDATA->{length};$i++) {
        if ($MINEDATA->{tryhint} ne chr(65+$i)) {
          $MINEDATA->{tryinit}.=chr(65+$i);
        }
      }
    } else {
      print "Error.. mined all possibilities\n";
      if ($MINER->{client}) { wsmessage($MINER->{client},"miner Error.. mined all possibilities :-(") }
    }
  }
}

sub initfcc {
  print "Initialising FCC Private Wallet Server ..\n";
  if (!$FORCENODE) {
    print "Connecting to FCC-Server .. \n";
    my $req=gclient::website("$FCCSERVER/?fcctime");
    if ($req->{error}) {
      print "Error connecting: $req->{error}\n"; exit
    }
    fcctime($req->content());
    print "FCC-Time set to $FCCTIME\n";
    $req=gclient::website("$FCCSERVER/?nodelist");
    @NODES=split(/ /,$req->content()); my $nc=1+$#NODES;
    if (!$nc) {
      print "The core is exhausted.. quitting.\n"; exit
    }
  }
}

sub init {
  my ($client) = @_;
  if ($client->{fcc}{connected}) { return }
  $client->{fcc}={};
  status($client,"FCC-Time offset to local clock = $FCCTIME seconds");
  if ($FORCENODE) {
    status($client,"Forcably using $FORCENODE\n")
  } else {
    my $nc=1+$#NODES;
    status($client,"The core has $nc nodes active");
  }
  $client->{fcc}{connectnode} = 1;
  $client->{fcc}{connected} = 1;
  $client->{fcc}{trans} = [];
}

sub initwallet {
  $WLIST=loadwallets($PASS);
  if ($#{$WLIST}<0) {
    print "Creating new wallet\n";
    my $wallet=newwallet("Main wallet");
    savewallet($wallet,$PASS);
    push @$WLIST,$wallet
  }
  $INIT=1
}

sub addwallets {
  my ($client) = @_;
  print "Initialising wallets and addressbook\n";
  status($client,"Initialising wallets and addressbook");
  foreach my $wallet (@$WLIST) {
    my $name=""; if ($wallet->{name}) { $name=$wallet->{name} }
    wsmessage($client,"addwallet $wallet->{wallet} $name")
  }
  if (-e 'addressbook.fcc') {
    my $cont=gfio::content('addressbook.fcc');
    my @lines=split(/\n/,$cont);
    foreach my $line (@lines) {
      wsmessage($client,"adrbook $line")
    }
  }
}

sub refreshnodelist {
  if ($FORCENODE) { return }
  print " * Refreshing node-list\n";
  my $req=gclient::website("$FCCSERVER/?nodelist");
  @NODES=split(/ /,$req->content()); my $nc=1+$#NODES;
  if (!$nc) {
    print "The core is exhausted.. quitting.\n"; exit
  }  
  $NODENR=0
}

sub connecttonode {
  my ($client) = @_;
  if ($client->{fcc}{reconnect} && (time < $client->{fcc}{reconnect})) { return }
  $client->{fcc}{reconnect}=time+10;
  my ($ip,$port);
  if ($FORCENODE) {
    ($ip,$port) = split(/\:/,$FORCENODE)
  } else {
    ($ip,$port) = split(/\:/,$NODES[$NODENR]);
  }
  status($client,"Connecting to node $ip:$port .. ");
  $NODENR++; if ($NODENR>$#NODES) { $NODENR=0 }
  $client->{fcc}{leaf}=startleaf($ip,$port,\&slavecall);
  if ($client->{fcc}{leaf}{error}) {
    print "Connection error to $ip:$port: $client->{fcc}{leaf}{error}\n";
    status($client,"<span style=\"color: red; font-weight: bold\">Connection error to $ip:$port: $client->{fcc}{leaf}{error}</span>");
  } else {    
    $client->{fcc}{leafid}=$client->{fcc}{leaf}{leafid};
    $client->{fcc}{leafip}=$ip; $client->{fcc}{leafport}=$port;
    $client->{fcc}{connectnode}=0;
  }
}

sub calctotal {
  my ($client) = @_;
  my $total=0;
  foreach my $t (@{$client->{fcc}{trans}}) {
    $total+=$t->{total}
  }
  wsmessage($client,"transtotal ".fccstring($total))
}

sub getpubkey {
  my ($wallet) = @_;
  foreach my $w (@$WLIST) {
    if ($w->{wallet} eq $wallet) { return $w->{pubkey} }
  }
}

sub getprivkey {
  my ($wallet) = @_;
  foreach my $w (@$WLIST) {
    if ($w->{wallet} eq $wallet) { return $w->{privkey} }
  }
}

sub handle {
  my ($client,$command,$data) = @_;
  if ($command eq 'handshake') {
    print "Website connected\n";
  } elsif ($command eq 'input') {
    if ($data eq 'init') {
      if (!$INIT) {
        if (walletisencoded()) {
          wsmessage($client,"getpass"); return
        }
      }
      initwallet();
      addwallets($client);
      init($client);
      wsmessage($client,"actwal ".$WLIST->[0]{wallet});
      if($MINING && $MINERWALLET){
        #print "MINEDATA:".gparse::str($MINEDATA)."\n";
        wsmessage($client,"mining ".encode_json({wallet=>$MINERWALLET,size=>[$MINFHASH,$MAXFHASH],data=>$MINEDATA}));
      }
    } elsif ($data =~ /^pass (.+)$/) {
      my $password=$1;
      if (validwalletpassword($password)) {
        $PASS=$password;
        print "Password accepted\n";
        status($client,"Password accepted");
        initwallet();
        addwallets($client);
        init($client);
        wsmessage($client,"passok");
        wsmessage($client,"actwal ".$WLIST->[0]{wallet})
      } else {
        wsmessage($client,"passinvalid")
      }
    } elsif ($data =~ /^newpass (.+)$/) {
      $PASS=$1; savewallets($WLIST,$PASS);
      status($client,"Password is set")
    } elsif ($data eq 'createwallet') {
      if (!$INIT) { return }
      my $wallet=newwallet();
      push @$WLIST,$wallet;
      savewallet($wallet,$PASS);
      wsmessage($client,"addwallet $wallet->{wallet}")      
    } elsif ($data =~ /^balance (.+)$/) {
      my $wallet=$1;
      push @{$client->{fcc}{jobs}},{ command => 'balance', wallet => $wallet }
    } elsif ($data =~ /^setname ([^\s]+) (.+)$/) {
      my $wallet=$1; my $name=$2;
      foreach my $w (@$WLIST) {
        if ($w->{wallet} eq $wallet) {
          $w->{name}=$name; savewallets($WLIST); last
        }
      }
    } elsif ($data =~ /^delwallet (.+)$/) {
      my $wallet=$1; my $NWL=[];
      foreach my $w (@$WLIST) {
        if ($w->{wallet} ne $wallet) { push @$NWL,$w }
      }
      $WLIST=$NWL;
      savewallets($WLIST);
      status($client,"Wallet $wallet deleted")      
    } elsif ($data =~ /^adrbook ([^\s]+) (.+)$/) {
      my $wallet=$1; my $name=$2;
      if (validwallet($wallet)) {
        if (-w 'addressbook.fcc') {
          gfio::append('addressbook.fcc',"\n$wallet $name")
        } else {
          gfio::create('addressbook.fcc',"$wallet $name")
        }
        status($client,"Added '$name' to addressbook");
        wsmessage($client,"adrbook $wallet $name")
      } else {
        wsmessage($client,"transerr Not added: Invalid wallet")
      }
    } elsif ($data =~ /^chadrbook ([^\s]+) (.+)$/) {
      my $wallet=$1; my $name=$2;
      if (!defined $name) { $name='' }
      my $data=gfio::content('addressbook.fcc');
      my @alist=split(/\n/,$data); my @out=();
      foreach my $entry (@alist) {
        my ($wal,@nlist) = split(/ /,$entry);
        if ($wal eq $wallet) {
          push @out,"$wal $name"
        } else {
          push @out,$entry
        }
      }
      gfio::create('addressbook.fcc',join("\n",@out))
    } elsif ($data =~ /^deladrbook (.+)$/) {
      my $wallet=$1;
      my $data=gfio::content('addressbook.fcc');
      my @alist=split(/\n/,$data); my @out=();
      foreach my $entry (@alist) {
        my ($wal,@nlist) = split(/ /,$entry);
        if ($wal ne $wallet) {
          push @out,$entry
        }
      }
      gfio::create('addressbook.fcc',join("\n",@out))
    } elsif ($data =~ /^checktrans ([^\s]+) ([^\s]+) (.+)/) {
      my $wallet=$1; my $amount=$2; my $fee=$3;
      if (!validwallet($wallet)) {
        wsmessage($client,"transerr Invalid wallet given for recipient")
      } elsif (($amount !~ /^[0-9]+$/) && ($amount !~ /^[0-9]+\.?[0-9]+$/)) {
        wsmessage($client,"transerr Invalid syntax for amount given")        
      } elsif (($fee !~ /^[0-9]+$/) && ($fee !~ /^[0-9]+\.?[0-9]+$/)) {
        wsmessage($client,"transerr Invalid syntax for fee given")
      } elsif ($amount == 0) {
        wsmessage($client,"transerr Amount must be larger then zero")        
      } elsif ($fee*100 < $MINIMUMFEE) {
        my $minfee=$MINIMUMFEE/100;
        wsmessage($client,"transerr The minimum fee is $minfee\%")
      } elsif ($fee>655.35) {
        wsmessage($client,"transerr The fee cannot be above 655.35%")
      } else {
        $TRANSCOUNT++; my $doggyfee=int($fee*100);
        $amount=fccstring($amount);
        $fee=calcfee($amount,$fee);
        my $total=fccstring($amount + $fee);
        wsmessage($client,"transok $TRANSCOUNT $amount $fee $total");
        push @{$client->{fcc}{trans}},{ 
          nr => $TRANSCOUNT, wallet => $wallet, amount => $amount, doggyfee => $doggyfee, fee => $fee, total => $total 
        };
        calctotal($client)
      }
    } elsif ($data =~ /^deltrans ([0-9]+)$/) {
      my $delnr=$1; my $cnt=0;
      foreach my $t (@{$client->{fcc}{trans}}) {
        if ($t->{nr} == $delnr) {
          splice(@{$client->{fcc}{trans}},$cnt,1); last
        }
        $cnt++
      }
      calctotal($client)
    } elsif ($data =~ /^transfer ([^\s]+) (.+)$/) {
      my $wallet=$1; my $change=$2;
      my $outlist=[];
      foreach my $t (@{$client->{fcc}{trans}}) {
        push @{$outlist},{ wallet => $t->{wallet}, amount => $t->{amount}*100000000, fee => $t->{doggyfee} }
      }
      push @{$client->{fcc}{jobs}},{ command => 'transfer', pubkey => getpubkey($wallet), change => $change, outlist => $outlist };
      $client->{fcc}{pubkey}=getpubkey($wallet);
      $client->{fcc}{privkey}=getprivkey($wallet);
      $client->{fcc}{trans}=[];
    } elsif ($data =~ /startminer (.+)$/) {
      $MINERWALLET=$1;
      push @{$client->{fcc}{jobs}},{ command => 'startminer' }
    } elsif ($data =~ /stopminer/) {
      if ($MINING) {
        $MINER->closeleaf(); $MINING=0; $MINEDATA->{coincount}=0
      }
    } elsif ($data =~ /powerdown/) {
      wsmessage($client,"powerdownnow");
      if ($MINING) { $MINER->closeleaf(); $MINING=0; $MINEDATA->{coincount}=0 }
      $POWERDOWN=1;
    } elsif ($data =~ /^savechat ([^\s]+) ([^\s]+)$/) {
      my $scc=$1; my $scv=$2; my $scs=0;
      if(($scc eq 'nick')||($scc eq 'ident')||($scc eq 'auto')||($scc eq 'zoom')){
        if(!defined $NICKIDENT->{$PORT}){
          $NICKIDENT->{$PORT}={$scc=>$scv};
        } else {
          $NICKIDENT->{$PORT}{$scc}=$scv;
        }
        gfio::create("nickident.chat",encode_json($NICKIDENT))
      }
    }

  } elsif ($command eq 'error') {
    if ($client->{websockets}) {
      print "Error in website connection! $data\n";
      $SERVER->quit();
      exit
    }
  } elsif ($command eq 'quit') {
    if ($client->{websockets}) {
      quitleaf($client);
      print "Lost connection to website! Reload website or press CNTRL C\n";
    }
  } elsif ($command eq 'ready') {
    # a very tiny httpd ;)
    my $uri=$client->{httpheader}{uri};
    my @out=(gserv::httpresponse(200));
    push @out,"Host: ".$SERVER->{server}{host}.":".$SERVER->{server}{port};
    push @out,"Access-Control-Allow-Origin: *";
    push @out,"Server: FCC-Private Wallet Server 1.0";
    push @out,"Date: ".fcctimestring();
    if ($uri eq '/') {
      burstfile($client,'wallet.htm','text/html',1,@out);
    } elsif ($uri eq '/wallet.js') {
      burstfile($client,'wallet.js','text/javascript',1,@out);
    } elsif ($uri eq '/wallet.css') {
      burstfile($client,'wallet.css','text/css',1,@out);
    } elsif ($uri =~ /image\/(.+)$/) {
      burstfile($client,"image/$1",$1 =~ /gif$/ ? 'image/gif':'image/png',0,@out);
    } else {
      $out[0]=gserv::httpresponse(404);
      my $hdata=join("\r\n",@out)."\r\n\r\n";
      gserv::burst($client,\$hdata);      
    }
    $client->{killafteroutput}=1
  }
  usleep(10000)
}

sub burstfile {
  my($client,$file,$meme,$filter,@out)=@_;
  my $data=($filter ? filtervars(gfio::content($file)) : gfio::content($file));
  push @out,"Content-Type: $meme";
  push @out,"Content-Length: ".length($data);
  my $hdata=join("\r\n",@out)."\r\n\r\n";
  $data=$hdata.$data;
  gserv::burst($client,\$data);
  return @out
}

sub filtervars {
  my($data)=@_;
  $data =~ s/\$PORT/$PORT/gs;

  if(defined $NICKIDENT->{$PORT} && defined $NICKIDENT->{$PORT}{nick}) {
    $data =~ s/\$NICK/$NICKIDENT->{$PORT}{nick}/gs;
  } else {
    $data =~ s/\$NICK//gs;
  }

  if (defined $NICKIDENT->{$PORT} && defined $NICKIDENT->{$PORT}{ident}) {
    $data =~ s/\$IDENT/$NICKIDENT->{$PORT}{ident}/gs;
  } else {
    $data =~ s/\$IDENT//gs;
  }

  if (defined $NICKIDENT->{$PORT} && $NICKIDENT->{$PORT}{auto}) {
    $data =~ s/\$AUTOSTART/openchat();/gs;
    $data =~ s/\$CHATAUTO/checked/gs;
  } else {
    $data =~ s/\$AUTOSTART//gs;
    $data =~ s/\$CHATAUTO//gs;
  }

  my $zm=100; if (defined $NICKIDENT->{$PORT} && $NICKIDENT->{$PORT}{zoom}) { $zm=$NICKIDENT->{$PORT}{zoom} }
  my @zo=();
  my @zc=();
  for my $z (500,400,300,250,200,175,150,125,120,110,100,90,80,75,70,60,50,40,30,25,20,15,10,5) {
    my $s=$z/100;
    push @zo, "<option value='$z'".($z==$zm ? ' selected':'').">$z %</option>";
    push @zc, ".zm$z { -ms-zoom: $s; -moz-transform: scale($s); -o-transform: scale($s); -webkit-transform: scale($s); -moz-transform-origin: 0 0; -o-transform-origin: 0 0; -webkit-transform-origin: 0 0; }"
  }
  my $zop=join('',@zo);   $data =~ s/\$ZOOMOPTION/$zop/gs;
  my $zcss=join("\n",@zc); $data =~ s/\$ZOOMCSS/$zcss/gs;

  return $data
}


sub status {
  my ($client,$txt) = @_;
  if (!$txt) { $txt="ERROR???" }
  wsmessage($client,"status $txt")
}

sub loop { }

sub handlecall {
  my ($client,$leaf,$command,$data) = @_;
  if (!$client->{fcc} || !$client->{fcc}{leafid} || !$leaf->{leafid}) { return }
  if ($client->{fcc}{leafid} == $leaf->{leafid}) {
    if ($command eq 'error') {
      if(ref($data) eq 'HASH' && $data->{message} && $data->{error}){
        print "Error '$data->{message}': $data->{error}\n";
        status($client,"<span style=\"color: red; font-weight: bold\">Error '$data->{message}': $data->{error}</span>");
      }else{
        print "Error '$data'\n";
      }
      $client->{fcc}{connectnode}=1;
      refreshnodelist();
    } elsif (($command eq 'disconnect') || ($command eq 'terminated')) {
      $MINERDISCON=1;
      $MINING=0;
      status($client,"<span style=\"color: red; font-weight: bold\">Disconnected from node.. Reconnecting to the FCC-core..</span>");
      $client->{fcc}{connectnode}=1;
      refreshnodelist();
    } elsif ($command eq 'response') {
      $client->{fcc}{leafready}=1;
      status($client," * Connected to node $data->{node} running FCC v$data->{version}")
    } elsif ($command eq 'balance') {
      my $balance=fccstring($data->{balance}/100000000);
      wsmessage($client,"balance $balance $data->{wallet}")
    } elsif ($command eq 'sign') {
      my $signature=octhex(Crypt::Ed25519::sign($data->{data},hexoct($client->{fcc}{pubkey}),hexoct($client->{fcc}{privkey})));
      $leaf->sign($data->{transid},$signature)
    } elsif ($command eq 'transstatus') {
      if ($data->{status} && ($data->{status} eq 'success')) {
        status($client,"<span style=\"color: darkgreen; font-weight: bold\">Transaction successfully processed</span>");
        push @{$client->{fcc}{jobs}},{ command => 'balance', wallet => $data->{wallet} }
      } elsif ($data->{error}) {
        status($client,"<span style=\"color: red; font-weight: bold\">Transaction refused: $data->{error}</span>")
      } else {
        status($client,"Transaction succesfully sent under id '$data->{transhash}'")
      }
    }
  }
}

sub slavecall {
  my ($leaf,$command,$data) = @_;
  if (!$data || (ref($data) ne 'HASH')) { error("No data HASHREF given from leaf! command = $command") }
  broadcastfunc($SERVER,\&handlecall,@_)
}

sub slaveminercall {
  my $log="coinbase.$PORT.log";
  my ($leaf,$command,$data) = @_;
  if (!$data || (ref($data) ne 'HASH')) { error("No data HASHREF given from leaf! command = $command") }
  if (!$data->{message}) { $data->{message}=$command }
  if (!$data->{error}) { $data->{error}="OK" }
  if ($command eq 'error') {
    print "Miner Error '$data->{message}': $data->{error}\n";
    wsmessage($leaf->{client},"miner <span style=\"color: red; font-weight: bold\">Error '$data->{message}': $data->{error}</span>");
#    wsmessage($leaf->{client},"minerstop");
    $MINERDISCON=1;
    $MINING=0
  } elsif (($command eq 'disconnect') || ($command eq 'terminated')) {
    if ($MINING) {
      my $mstr=time." stopped $MINEDATA->{coincount} $MINEDATA->{diff}\n";
      if (-e $log) { gfio::append($log,$mstr) } else { gfio::create($log,$mstr) }
      print "Miner Stopped '$data->{message}': $data->{error}\n";
      wsmessage($leaf->{client},"miner <span style=\"color: red; font-weight: bold\">Terminated '$data->{message}': $data->{error}</span>");
#      wsmessage($leaf->{client},"minerstop");
      $MINERDISCON=1;
      $MINING=0
    }
  }
  if ($command eq 'mine') {
    print "miner New challenge: Coincount = $data->{coincount} Difficulty = $data->{diff} Reward = $data->{reward} Len = $data->{length} Hints = $data->{hints}\n";
    if (!$MINING || ($data->{coincount} > $MINEDATA->{coincount})) {
      my $mstr=time." coinbase $data->{coincount} $data->{diff}\n";
      if (-e $log) { gfio::append($log,$mstr) } else { gfio::create($log,$mstr) }
      if ($MINER->{client}) { wsmessage($MINER->{client},"miner New challenge: Coincount = $data->{coincount} Difficulty = $data->{diff} Reward = $data->{reward} Len = $data->{length} Hints = $data->{hints}") }
      challenge($data);
    }
  } elsif ($command eq 'solution') {
    my $mstr=time." solution $MINEDATA->{coincount} $MINEDATA->{diff}\n";
    if (-e $log) { gfio::append($log,$mstr) } else { gfio::create($log,$mstr) }
    print " *** Found solution!! Earned FCC ".extdec($MINEDATA->{reward} / 100000000)." ***\n";
    if ($MINER->{client}) {
      wsmessage($MINER->{client},"miner <span style=\"color: darkgreen; font-weight: bold\">Found solution!! Earned FCC ".extdec($MINEDATA->{reward} / 100000000)."</span>");
      my $ctm=gettimeofday();
      push @{$MINER->{client}{fcc}{jobs}},{ command => 'balance', wallet => $MINERWALLET, time => $ctm }
    }
  }
}

# EOF (C) 2018 Chaosje
```

---

- `wallet/wallet.htm`:
```html
<!DOCTYPE HTML>

<!-- HTML5 WebSocket WebChat 2018 (C) Domero -->

<html>

  <head>
    <title>FCC Private Wallet</title>
    <meta name="description" content="Manage your private wallet" />
    <meta name="author" content="(C) 2018, Chaosje, Domero, Groningen." />
    <meta name="copyright" content="(C) 2018, Chaosje, Domero, Groningen." />
    <meta name="robots" content="none" />
    <meta charset="UTF-8" />
    <link type="image/png" href="/image/favicon-16.png" sizes="16x16" rel="icon" />
    <link type="image/png" href="/image/favicon-32.png" rel="icon" sizes="32x32" />
    <link type="text/css" href="wallet.css" rel="stylesheet" />
    <script type="text/javascript" src="wallet.js"></script>
  </head>
  
  <body onload="start()">

    <div id="graybg"></div>
    <div id="refresh">The FCC Private server is offline.<br /><br />Please refresh the server and/or this site!</div>
    
    <div id="transconfirm">Confirm Transaction
      <div class="tctit" style="top: 50px;">From</div>
      <div id="tcfrom"></div>
      <div class="tctit" style="top: 130px;">To</div>
      <div id="tcout"></div>
      <div class="tctit" style="bottom: 180px;">Wallet to send spare change to</div>
      <div id="tcchange"></div>
      <div class="tctit" style="bottom: 110px;">Total amount</div>
      <div id="tctotal"></div>
      <div id="tcok" class="selbut greenbut muis" onclick="tcok()">Confirm Transaction</div>
      <div id="tccancel" class="selbut redbut muis" onclick="tccancel()">Cancel</div>
    </div>
    
    <div id="editadrbook">
      Edit Addressbook
      <div id="ablist"></div>
      <div class="tctit" style="bottom: 180px;">Create new entry</div>
      <div class="eatit" style="bottom: 140px;">Wallet address</div>
      <div class="eatit" style="bottom: 100px;">Name</div>
      <div id="aeadd" class="selbut bluebut muis" onclick="aeadd()">Add</div>
      <div id="aeerr"></div>
      <div id="aeok" class="selbut greenbut muis" onclick="aeok()">Done</div>
      <div id="nab">
        <input id="abnewwal" onkeyup="checkhex(event,'abnewwal')" onpaste="checkhexpaste('abnewwal')" />
        <input id="abnewname" />
      </div>
    </div>
    
    <div id="active">
      <div id="powerbutton"
        onclick="if(confirm('Click Ok to confirm you want to close down your wallet / miner')) powerDownWallet()"
      ><img id="powerimage" src="image/powerdown.png" height="64" class="muis" onclick="powerdown()" title="Powerdown the Wallet and Miner" /></div>

      <div id="minerstopped">
        <img id="startminer" class="muis" onclick="startminer()" src="image/start.png" title="Start Miner on Current Selected Wallet" />
      </div>
      <div id="minerrunning">
      </div>
      <div id="miner">
        <img id="stopminer" class="muis" onclick="stopminer()" src="image/pause.png" title="Stop Mining" />
        <img id="diffaxe" class="muis" onclick="stopminer()" src="image/pickaxe.gif" />
        <div id="minewallet"></div>
        <div id="mineoutput">Miner inactive</div>
        <div id="minediff"></div>
        <div id="minecanv">
          <canvas id="minecanvas" width="1000" height="100"></canvas>
          <canvas id="diffcanvas" width="2000" height="100"></canvas>
          <canvas id="coincanvas" width="2000" height="100"></canvas>
          <div id="minespeed"></div>
        </div>
      </div>

      <div id="activefront">
        <div id="wallet" onclick="copywal()" ></div>
        <img id="fcc" src="image/fccico.png" height="36" />
        <img id="pickaxe" src="image/pickaxe.gif" />
        <div id="balance"></div>
        <div id="walnamediv">
          <input id="walname" class="ival" autocomplete="off" onkeydown="checksubmit(event,'savewalbut')" onchange="savewalname()" title="Edit Wallet Name" />
        </div>
        <img id="savewalbut" src="image/save.png" class="muis" title="Save Wallet Name" />
        <img id="copywallet" src="image/clipboard.png" class="muis" onclick="copywal()" title="Copy Wallet Address to Clipboard" />
        <div id="copied"></div>
        <img id="delwalbut" class="muis" onclick="delwal()" src="image/del.png" />
      </div>

    </div>
    
    <div id="winleft">
      <div id="transwallets" class="abovebut selectbut" onclick="yourwallets()">Wallets</div>
      <div id="transcontacts" class="abovebut muis" onclick="adrbookinterface()">Contacts</div>
      <div id="create" class="belowbut muis" onclick="createwallet()">Create new wallet</div>
      <div id="import" class="belowbut muis" onclick="importwallet()">Import wallet</div>
      <div id="passprotect" class="abovebut muis" onclick="passprotect()">Set Password</div>
      <div id="createatrans" class="bottombut selectbut" onclick="createatrans()">Transactions</div>
      <div id="wallets"><div class="space"></div></div>
      <div id="trans">
    	  <div id="transbox">
	        <div class="tfnt" style="top: 3px;">From</div>
	        <div id="from"></div>
	        <div class="tfnt" style="top: 43px;">Amount</div>
	        <input id="amount" onfocus="document.getElementById('amount').select()" onkeyup="checkdigit(event,'amount',1)" value="0.00000000" />
	        <div class="tfnt" style="left: 140px; width: 40px; top: 43px;">Fee</div>
  	      <input id="fee" onfocus="document.getElementById('fee').select()" onkeyup="checkdigit(event,'fee',1)" value="0.5" />
  	      <div class="tfnt" style="left: 200px; top: 66px; width: 12px">%</div>
 	        <div class="tfnt" style="top: 93px;">To</div>
	        <input id="to" onfocus="document.getElementById('to').select()" onkeyup="checkhex(event,'to')" onpaste="checkhexpaste('to')" />
	        <select id="adrbook" class="adrbook" onchange="setadrbook()" title="Select from Addressbook"><option value="" selected>Select</option></select>
  	      <input id="newadrbook" onkeydown="checksubmit(event,'saveadrbook')" />
	        <img id="saveadrbook" src="image/save.png" height="38" class="muis" onclick="saveadrbook()" title="Save to Addressbook" />
          <div id="addtransbut" class="selbut bluebut muis" onclick="addtrans()">Add Transaction</div>
	        <div id="transerr"></div>
	        <div id="transoutbox"></div>
	        <div class="tfnt" style="width: 130px; bottom: 40px;">Change wallet address</div>
	        <select id="change"></select>
	        <img id="ttot" src="image/fccico.png" height="24" />
	        <div id="transtotal">0.00000000</div>
	        <div id="transbut" onclick="transfer()" class="selbut greenbut muis"> &nbsp;Transfer &#x2192;</div>
    	  </div>
      </div>
    </div>

    <div id="winright">
      <div id="openchat" class="abovebut selectbut muis" onclick="openchat()">Open Chatbox</div>
      <input id="chatauto" type="checkbox" onclick="savechatauto(this.checked)" title="Open on startup and reloads." $CHATAUTO />
      <div id="chat">
        <div id="chatcont" class="cont"></div>
        <input id="chatnick" type="text" class="belowbut selectbut" value="$NICK" onchange="savechatnick(this.value)" placeholder="Chatnick" title="Enter default Chatnick" />
        <input id="identpass" type="password" class="belowbut selectbut" value="$IDENT" onchange="savechatident(this.value)" placeholder="Identify" title="Enter default Identify Password ( * optional )
( register your nick first with NickServ
  to claim the ownership of your nickname )" />
        <select id="chatzoom" class="abovebut selectbut" onwheel="this.value=this.options[(event.wheelDelta>0 ? this.selectedIndex>0 ? this.selectedIndex-1:this.selectedIndex:this.selectedIndex<this.options.length-1 ? this.selectedIndex+1:this.selectedIndex)].value;this.onchange();" onchange="savechatzoom(this.options[this.selectedIndex].value);" title="Select the Chatbox Zoom Size
or Scroll with the mouse wheel
to zoom in and out">$ZOOMOPTION</select>
      </div>
      <div id="status">Welcome to FCC Private Wallet v1.0</div>
    </div>
    
    <div id="passbox" class="centbox loginbox">
      <b>Unlock your wallet</b><br>
      <div class="tmarg">
        <table class="t">
          <tr><td class="itext">Password</td><td><input type="password" class="ival" id="wachtwoord" onkeydown="checksubmit(event,'passbut')" /></td></tr>
          <tr><td colspan="2"><div id="passerr" class="errtxt"></div></td></tr>
          <tr><td colspan="2" class="tdr"><div id="passbut" class="sbut muis" onclick="checkpass()">OK</div></td></tr>
        </table>
      </div>
    </div>
    
    <div id="newpassbox" class="centbox loginbox">
      <b>Set a password to encrypt your wallet</b><br /></br >
      <div class="tmarg">
        <table class="t">
          <tr><td class="itext">Password</td><td><input type="password" class="ival" id="newpass" onkeydown="checkenter(event,'newpassvld')" /></td></tr>
          <tr><td class="itext">Repeat Password</td><td><input type="password" class="ival" id="newpassvld" onkeydown="checksubmit(event,'newpassbut')" /></td></tr>
          <tr><td colspan="2"><div id="newpasserr" class="errtxt"></div></td></tr>
          <tr><td class="tdr"><div id="newpassbut" class="sbut muis" onclick="setnewpass()">OK</div></td><td class="tdr"><div class="sbut cancbut muis" onclick="cancelnewpass()">Cancel</div></td></tr>
        </table>
      </div>
    </div>

  </body>
</html>
```

---

- `wallet/wallet.css`:
```css

  body {
    background: #f0f8ff;
    padding: 0; margin: 0;
  }
  * {
    outline: none;
  }
  br {
    display: block; /* makes it have a width */
    content: ""; /* clears default height */
    margin-top: 0; /* change this to whatever height you want it */
  }
  ::-webkit-scrollbar {
    width: 18px;
  } 
  ::-webkit-scrollbar-track {
    -webkit-box-shadow: inset 0 0 6px rgba(0,0,0,0.3); 
    border-radius: 10px;
  } 
  ::-webkit-scrollbar-thumb {
    border-radius: 10px;
    -webkit-box-shadow: inset 0 0 6px rgba(0,0,0,0.5); 
  }
  .muis:hover {
    cursor: pointer;
  }
  .cont {
  	position: absolute;
  	left: 0px; right: 0px; bottom: 0px; top: 0px;
  	margin: auto;
  }
  
  #graybg {
  	position: fixed;
  	left: 0px; top: 0px;
    right: 0px; bottom: 0px; 
  	margin: auto;
  	background: #a0a0a0;
    opacity: 0.8;
    z-index: 50;
    visibility: hidden;
  }
  
  #refresh {
  	position: absolute;
  	left: 0; right: 0; bottom: 120px; top: 0;
  	margin: auto;
  	width: 450px; height: 160px;
  	border: 3px solid red;
  	padding: 10px;
  	padding-top: 60px;
  	background: black;
  	color: white;
  	font-family: Verdana;
  	font-size: 26px;
  	text-align: center;
  	z-index: 200;
  	visibility: hidden;
  }
  
  .centbox {
    position: fixed;
    top: 0; left: 0; bottom: 220px; right: 0;
    margin: auto;
  }
  .loginbox {  
    width: 450px;
    height: 170px;
    padding: 15px;
    overflow: none;
    border-radius: 15px;
    border: 1px ridge #4589a0;
    font-family: verdana;
    font-size: 20px;
    color: #004;
    box-shadow: 6px 6px 3px #888888;
    background: #f0f4ff;
    z-index: 100;
    visibility: hidden;
  }
  
  #newpassbox {
  	height: 190px;
  }
  .tmarg {
    margin-top: 20px;
  }
  .t {
    width: 95%;
  }
  .itext {
    text-align: right;
    padding-right: 7px;
    font-family: tahoma;
    font-size: 18px;
    color: #004;
  }
  .ival {
    padding-left: 5px;
    padding-right: 5px;
    border-radius: 5px;
    background: #f0fdff;
    color: #005;
    width: 100%;
    font-family: arial;
    font-size: 16px;
  }
  .tdr {
    text-align: right;
    padding-right: 10px;
    padding-top: 15px;
    width: 100%;
  }
  .sbut {
    width: 80px;
    text-align: center;
    margin-left: auto;
    border-style: outset;
    border-radius: 10px;
    border-width: 3px;
    border-color: #8090b0;
    color: #f0f3ff;
    background: #607090;
    font-family: verdana;
    font-weight: bold;
  }
  .cancbut {
  	width: 110px;
  }
  .errtxt {
    font-family: tahoma;
    font-size: 12px;
    color: #800;
    font-weight: bold;
  }
  
  #active {
  	position: fixed;
  	left: 0; top: 0; right: 0px; height: 215px;
   	margin: auto;
  	overflow: none;
    background: #0073a3;
  	color: black;
  	padding: 7px;
  	border: 3px ridge #205090;
  	font-size: 13px;
  	font-family: Verdana;
    background-image:url(image/fccwallet.png);
    background-size: auto 164px;
    background-position: -19px 64px;
    background-repeat: no-repeat;
    background-attachment: scroll;
  }
  
  #powerbutton {
  	position: absolute;
  	right: 6px; top: 6px; width: 64px; height: 64px;
   	margin: auto;
  	overflow: hidden;
  	background: rgba(255,0,0,0.5);
  	color: black;
  	padding: 7px;
  	border: 3px ridge #205090;
    border-radius: 64px;
  }
  #powerimage {
  	position: relative;
   	margin: 0px;
  }
  
  #activefront {
  	position: absolute;
    top: 96px; left: 6px; right: 6px; bottom: 32px;
   	margin: auto;
  	overflow: hidden;
  	background: linear-gradient(to right, rgba(66,115,166,0.4), rgba(35,35,110,0.5));
  	color: black;
  	padding: 7px;
  	border: 3px ridge #205090;
  	font-size: 13px;
  	font-family: Verdana;
    border-top-left-radius: 64px;
    border-bottom-left-radius: 64px;
  }
  
  #balance {
    position: absolute;
    left: 40px;
    top: 28px;
    width:320px;
    border:1px solid rgba(0,0,0,0);
    font-family: Arial;
    font-size: 32px;
    font-weight: bolder;
    text-align:right;
    color: #102080;
    text-shadow: 0px 0px 6px rgba(155,255,255,0.8);
  }

  #walnamediv {
    position: absolute;
    left: 415px;
    top: 11px;
    height: 20px;
    right: 42px;
    font-size: 17px;
  }
  #walname {
    position: absolute;
    left: 0px;
    top: 0px;
    height: 20px;
    font-size: 17px;
    visibility: hidden;
  }
  #wallet {
    position: absolute;
    left: 415px; top: 40px;
    right: 32px; bottom: 8px;
    font-family: "Lucida Console";
    font-size: 24px;
    line-height: 24px;
    font-weight: bolder;
    color: #101070;
    word-break: break-all;
    overflow-y: hidden;
    text-shadow: 0px 0px 3px rgba(200,250,200,0.5);
    cursor:pointer;
  }


  #copywallet {
    position: absolute;
    left: 373px; top: 46px; height: 32px;
    visibility: hidden;
  }

  #savewalbut {
  	position: absolute;
  	left: 373px;
    top: 8px;
    height: 32px;
  	visibility: hidden;
  }

  #fcc {
  	position: absolute;
  	left: 375px;
  	top: 26px;
  	height: 32px;
  	visibility: hidden;
  }
  #delwalbut {
  	position: absolute;
  	right: 4px;
  	width: 16px;
  	top: 4px;
  	font-size: 18px;
  	visibility: hidden;
  }
  #copied {
  	position: absolute;
  	left: 72px; top: 70px;
  	font-family: arial;
  	font-size: 16px;
  	font-weight: bold;
  	color: #004000;
  }


  #minerrunning {
    display: none;
    position: absolute;
    left: 6px; top: 6px; right: 96px; height: 82px;
    margin: auto;
    overflow: auto hidden;
    padding: 0;
    border: 3px ridge #205090;
    background: linear-gradient(to right, rgba(55,55,130,0.3), rgba(66,115,166,0.5));
    border-top-left-radius: 64px;
    border-bottom-left-radius: 64px;
  }
  #minerstopped {
    display: block;
    position: absolute;
    left: 6px; top: 6px; width: 82px; height: 82px;
    margin: auto;
    overflow: auto hidden;
    padding: 0;
    border: 3px ridge #205090;
    background: linear-gradient(to right, rgba(55,55,130,0.3), rgba(66,115,166,0.5));
    border-radius: 64px;
  }
  #startminer {
    position: absolute;
    left: 9px; top: 9px; height: 64px;
  }
  #stopminer {
    position: absolute;
    left: 9px; top: 9px; height: 64px;
  }

  #miner {
    display: none;
    position: absolute;
    left: 9px; top: 8px; right: 96px; height: 84px;
    margin: auto;
    overflow: auto hidden;
    padding: 0;
  }

  #minewallet {
    position: absolute;
    left: 80px; top: 1px;
    width: 495px; bottom:0px;
    overflow: hidden;
    font-family: Courier New;
    font-size: 10px;
    line-height: 10px;
    font-weight: bolder;
    padding-left:3px;
    padding-top:1px;
    color: black;
    background:white;
    border: 1px inset #205090;
  }

  #mineoutput {
    position: absolute;
    left: 81px; top: 26px; bottom: 2px; width: 188px;
    margin: auto;
    overflow: auto;
    padding: 3px;
    font-family: Courier New;
    font-size: 9px;
    font-weight: bolder;
    color: #000020;  
  }

  #minediff {
    position: absolute;
    left: 274px; top: 22px; bottom: 4px; width:304px;
    font-family: Courier New;
    font-size: 9px;
    line-height: 10px;
    font-weight: bolder;
  }

  #minecanv {
    position: absolute;
    left: 580px; top: 0px;
    right: 2px; bottom: -1px;
    border: 1px inset #205090;
  }

  #cointable {
    position:absolute;
    left:1%px; top:0px;
    width:99%; height:100%;
    margin:0px auto;
  }
  #cointable th {
    background:black;
    color:white;
    text-align:right;
    padding:1px 3px;
    white-space:nowrap;
  }
  #cointable tr:first-child th {
    border-top-left-radius: 4px;
    border-top-right-radius: 4px;
  }
  #cointable tr:last-child th {
    border-bottom-left-radius: 4px;
    border-bottom-right-radius: 4px;
  }
  #cointable td {
    text-align:right;
    padding-right:3px;
    white-space:nowrap;
    border:1px solid white;
  }
  #cointable tr:first-child {
    padding-top:1px;
  }
  #cointable tr:last-child {
    padding-bottom:1px;
  }
  #coinreward {}
  #coincount {}
  #coinwon {}
  #coindiff {}
  #coinlength {}
  #coinhint {
    text-align:left;
  }
  #coinprc {}
  #coinsec {}
  #coinfhs {}

  #minecanvas {
    position: absolute;
    left:0px; top:0px;
    width: 100%; height: 100%;
  }
  #diffcanvas {
    position: absolute;
    left:0px; top:0px;
    width: 100%; height: 100%;
  }
  #coincanvas {
    position: absolute;
    left:0px; top:0px;
    width: 100%; height: 100%;
  }
  #minespeed {
    position: absolute;
    right:10px;
    top: 0px;
    text-align: center;
    font-size: 11px;
    font-weight: bolder;
    color: white;
    line-height: 27px;
    text-shadow: 0px 0px 3px rgba(0,0,0,0.5);
  }

  #pickaxe {
    display: none;
    position: absolute;
    left: 24px; top: 24px;
    width: 48px; height: 48px;
  }

  #diffaxe {
    display: none;
    position: absolute;
    left: 16px; top: 16px;
    width: 48px; height: 48px;
    cursor: pointer;
  }


  #winleft {
  	position: fixed;
  	left: 0px; top: 204px; width: 490px; bottom: 0px;
   	margin: auto;
  	overflow: none;
  }
  
  #transwallets {
    left: 6px;
    width: 70px;
  }
  #transcontacts {
    left: 106px;
    width: 70px;
  }

  #import {
    left: 150px;
    width: 130px;
  }
  #create {
    left: 310px;
    width: 150px;
  }

  #passprotect {
    left: 230px;
    width: 130px;
  }

  #createatrans {
    left: 6px;
    width: 110px;
  }

  .abovebut {
    position: absolute;
    top: 0px;
    height: 22px;
    background: #b3b3b9;
    color: black;
    border-left: 1px solid #eeeeee;
    border-top: 1px solid #eeeeee;
    border-bottom: 2px solid #222222;
    border-right: 2px solid #222222;
    border-top-left-radius: 10px;
    border-top-right-radius: 10px;
    padding-top: 3px;
    padding-bottom: 3px;
    padding-left: 10px;
    padding-right: 10px;
    font-size: 18px;
    font-family: Tahoma;
    text-align: center;
    text-shadow: -1px -1px white;
  }
  .belowbut {
    position: absolute;
    top: 167px;
    height: 22px;
    margin: auto;
    background: #b3b3b9;
    color: black;
    border-left: 1px solid #eeeeee;
    border-top: 1px solid #eeeeee;
    border-bottom: 2px solid #222222;
    border-right: 2px solid #222222;
    border-bottom-left-radius: 10px;
    border-bottom-right-radius: 10px;
    padding-top: 2px;
    padding-bottom: 3px;
    padding-left: 10px;
    padding-right: 10px;
    font-size: 18px;
    font-family: Tahoma;
    text-align: center;
    text-shadow: -1px -1px white;
  }

  .bottombut {
    position: absolute;
    top: 172px;
    height: 22px;
    margin: auto;
    background: #b3b3b9;
    color: black;
    border-left: 1px solid #eeeeee;
    border-top: 1px solid #eeeeee;
    border-bottom: 2px solid #222222;
    border-right: 2px solid #222222;
    border-top-left-radius: 10px;
    border-top-right-radius: 10px;
    padding-top: 3px;
    padding-bottom: 3px;
    padding-left: 10px;
    padding-right: 10px;
    font-size: 18px;
    font-family: Tahoma;
    text-align: center;
    text-shadow: -1px -1px white;
  }


  .selectbut {
    color: white;
    cursor: default;
    background: #205090;
    text-shadow: 1px 1px 3px rgba(0,0,0,0.7);
  }

  #wallets {
  	position: absolute;
  	left: 0px; top: 28px; right: 0px; height: 120px;
   	margin: auto;
  	overflow: auto;
  	padding: 7px;
  	border: 3px ridge #205090;
  	background: white;
  	color: black;
  	font-size: 18px;
  	font-family: Verdana;
  }
  .space {
    width: 100%; height: 4px;
  }
  
  .rwal {
    position: relative;
    display: inline-block;
    width:100%;
    margin: 5px auto;
  }
  .iwal {
    position: absolute;
    left:0px; top:0px; right: 24px;
    font-family: "Lucida Console";
    font-size: 11px;
    line-height: 9px;
    font-weight: bolder;
    color: #2060a0;
    background: #cceeff;
    padding: 4px;
    border: 1px solid #000080;
    white-space: nowrap; 
    overflow: hidden;
    text-overflow: clip;
  }
  .cwal {
    position: absolute;
    top: 0px; right:0px; width: 16px;
  }


  #trans {
    position: absolute;
    left: 0px; top: 197px; bottom: 0px; right: 0px;
    margin: auto;
    margin-top: 3px;
    overflow-x: hidden;
    overflow-y: auto;
    padding: 7px;
    border: 3px ridge #205090;
    background: white;
    color: black;
    font-size: 18px;
    font-family: Verdana;
  }


  #transbox {
  	position: absolute;
  	top: 3px; left: 6px; right: 6px;
    min-height: 420px; bottom: 6px;
  	background: #f0f0f0;
  }
  .tfnt {
  	position: absolute;
  	width: 80px;
  	text-align: left;
  	font-family: verdana;
  	font-size: 13px;
    font-weight: bolder;
  	color: black;
  }
  .tafnt {
  	position: absolute;
  	font-family: verdana;
  	font-size: 18px;
  	color: black;
  }
  #from {
  	position: absolute;
  	top: 18px; left: 5px;
  	font-family: "Lucida Console";
  	font-size: 11px;
  	color: #000080;  	
  }
  #amount {
  	position: absolute;
  	top: 60px; left: 5px;
  	width: 120px;
  	font-family: "Lucida Console";
  	padding: 3px;
  	font-size: 18px;
  	color: #000040;
  	border: 1px blue solid;
  }
  #fee {
  	position: absolute;
  	top: 60px; left: 140px;
  	width: 50px;
  	font-family: "Lucida Console";
  	padding: 3px;
  	font-size: 18px;
  	color: #000040;
  	border: 1px blue solid;
  }
  #to {
  	position: absolute;
  	top: 110px; left: 5px;
  	width: 420px;
  	font-family: "Lucida Console";
  	padding: 3px;
  	font-size: 16px;
  	color: black;
  	border: 1px blue solid;
  }
  #adrbook {
    position: absolute;
    top: 140px; left: 5px; width: 90px;
    height: 28px;
    background: #603000;
    font-family: Tahoma;
    font-size: 16px;
    color: white;
    padding-left: 3px;
  }
  #newadrbook {
  	position: absolute;
  	top: 140px; left: 95px;
  	width: 170px;
  	font-family: "Verdana";
  	padding: 3px;
  	font-size: 18px;
  	color: black;
  	border: 1px #603000 solid;
  }
  #saveadrbook {
    position: absolute;
    top: 136px; left: 270px;
  }
  #addtransbut {
    position: absolute;
    top: 140px; left: 310px;  width: 140px;
    font-size: 13px; padding:3px 5px;
    font-variant: small-caps;
  }
  #transerr {
    position: absolute;
    left: 5px; top: 174px;
    width: 470px;
    max-height: 32px;
    height:32px;
    overflow:none auto;
    font-family: Verdana;
    font-size: 16px;
    text-align: center;
    color: red;
    font-weight: bolder;
  }
  #transoutbox {
    position: absolute;
    left: 3px; top: 200px; right: 3px; min-height:48px; bottom: 70px;
    margin: auto;
    overflow: auto;
    background: #e0e0e0;
    padding: 3px;
  }
  #change {
  	position: absolute;
  	bottom: 40px; left: 140px; width: 330px;
  	height: 18px;
  	background: #003060;
  	font-family: Tahoma;
  	font-size: 12px;
  	color: white;
  	padding-left: 3px;  	
  }
  #transbut {
    position: absolute;
    right: 20px; bottom: 3px;
    font-size: 13px; padding:3px 10px;
    font-variant: small-caps;
  }

  .transoutitem {
  	position: relative;
  	left: 0; right: 0; height: 50px;
  	border-bottom: 1px solid #800000;
  	margin-bottom: 3px;
  }
  .walletout {
  	position: absolute;
  	left: 3px; top: 3px;
  	right: 10px; height: 18px;
  	white-space: nowrap; 
    overflow: hidden;
  	text-overflow: clip;
  	color: #600000;
  	font-family: "Lucida Console";
  	font-size: 13px;
  }
  .totalout {
  	position: absolute;
  	right: 10px; top: 30px;
    color: #a00000;
  	font-family: "Lucida Console";
  	font-size: 20px;
  }
  .amountout {
  	position: absolute;
  	left: 10px; top: 20px;
    color: #900000;
  	font-family: "Lucida Console";
  	font-size: 14px;
  }
  .feeout {
  	position: absolute;
  	left: 10px; top: 35px;
    color: #900000;
  	font-family: "Lucida Console";
  	font-size: 14px;
  }
  .delout {
  	position: absolute;
  	right: 3px; top: 3px;
  }
  #ttot {
  	position: absolute;
  	left: 12px; bottom: 4px;
  }
  #transtotal {
  	position: absolute;
  	left: 45px; bottom: 5px;
    color: #a00000;
  	font-family: "Lucida Console";
  	font-size: 20px;
  }
  #transconfirm {
  	position: absolute;
  	left: 150px; top: 100px; bottom: 250px; right: 150px;
  	background: #f0fff0;
  	border: 3px blue solid;
  	z-index: 50;
  	font-family: verdana;
  	font-size: 26px;
  	font-weight: bold;
  	color: #000030;
  	padding-left: 15px;
  	padding-top: 5px;
  	visibility: hidden;
  }
  .tctit {
  	position: absolute;
  	left: 30px; right: 30px;
  	border-bottom: 1px solid #000050;
  	font-family: verdana;
  	font-size: 22px;
  	color: #000090;
  }
  #tcfrom {
  	position: absolute;
  	left: 40px; top: 85px;
  	font-family: "Lucida Console";
  	font-size: 20px;
  	color: #000030;  	
  }
  #tcout {
  	position: absolute;
  	left: 40px; top: 165px; right: 30px; bottom: 220px;
  	font-family: "Lucida Console";
  	font-size: 14px;
  	color: #000030;
  	overflow: auto;
  	background: #e0ffe0;
  }
  .tcoutblock {
    position: relative;
    left: 0px; right: 0px; height: 40px;
  }
  .tcoutwal {
  	position: absolute;
  	left: 0px; top: 0px; right: 150px;
   	white-space: nowrap; 
    overflow: hidden;
    text-overflow: clip;
  }
  .tcoutamount {
  	position: absolute;
  	top: 0px; right: 0px;
  	color: #a00000;
  	font-size: 16px;
  }
  .tcoutfee {
  	position: absolute;
  	top: 22px; right: 0px;
  	color: #800000;
  	font-size: 12px;
  }
  #tcchange {
  	position: absolute;
  	bottom: 142px; left: 40px; right: 30px;
  	color: #000060;
  	font-size: 16px;
  }
  #tctotal {
  	position: absolute;
  	bottom: 75px; right: 30px;
  	color: #c00000;
  	font-size: 24px;
  }
  #tcok {
  	position: absolute;
  	bottom: 15px; right: 230px;
  	font-size: 22px;
  }
  #tccancel {
  	position: absolute;
  	bottom: 15px; right: 30px;
  	font-size: 22px;
  }



  #winright {
  	position: fixed;
  	left: 485px; top: 204px; right: 0px; bottom: 0px;
   	margin: auto;
  	overflow: none;
  }

  #openchat {
    position: absolute;
    left: 10px; top: 0px; width: 150px;
  }
  #chatauto {
    position: absolute;
    left: 17px; top: 6px;
  }
  #chatnick {
    position: absolute;
    left: 2px; top: -2px; width: 100px;
    height:16px;
    font-size:12px;
    line-height: 12px;
    cursor:text;
    background: white;
    color:black;
    border:ridge 3px #205090;
  }
  #identpass {
    position: absolute;
    left: 130px; top: -2px; width: 100px;
    height:16px;
    font-size:12px;
    line-height: 12px;
    cursor:text;
    background: white;
    color:black;
    border:ridge 3px #205090;
  }
  #chatzoom {
    display: none;
    position: absolute;
    right: 6px; top: 6px; width: 64px;
    height:20px;
    padding:2px 0px 0px 0px;
    font-size:10px;
    line-height: 12px;
    font-family: Courier New;
    text-align: right;
    cursor:pointer;
    border:ridge 2px #205090;
    border-bottom:0px;
  }


  #chat {
  	position: absolute;
  	left: 3px; top: 28px; right: 0px; bottom: 78px;
   	margin: auto;
  	overflow: hidden;
  	padding: 0;
  	border: 3px ridge #205090;
  	background: white;
  }

  #chatcont {
    top:26px;
    border-top: dashed 1px rgba(0,0,0,0.2);
  }

  #chatframe {
  }






  #status {
    position: absolute;
    left: 3px; bottom: 0px; right: 0px; height: 61px;
    margin: auto;
    overflow: auto;
    padding: 7px;
    border: 3px ridge #205090;
    background: white;
    color: black;
    font-size: 13px;
    font-family: "Lucida Console";
  }





  .selbut {
  	padding-left: 10px;
  	padding-right: 10px;
  	padding-top: 5px;
  	padding-bottom: 5px;
  	font-family: Verdana;
  	font-size: 24px;
  	font-weight: bold;
  	text-shadow: -1px -1px #ffffff;
  	text-align: center;
  	letter-spacing: 2px;  	
  }
  .greenbut {
  	border-left: 2px solid #aeeeae;
  	border-top: 2px solid #aeeeae;
  	border-bottom: 2px solid #002200;
  	border-right: 2px solid #002200;
  	border-radius: 12px;
  	color: #50c090;
  	background: #208030;
  }
  .redbut {
  	border-left: 2px solid #ffaeae;
  	border-top: 2px solid #ffaeae;
  	border-bottom: 2px solid #220000;
  	border-right: 2px solid #220000;
  	border-radius: 12px;
  	color: #c05090;
  	background: #802030;
  }
  .bluebut {
  	border-left: 2px solid #aeaeff;
  	border-top: 2px solid #aeaeff;
  	border-bottom: 2px solid #000022;
  	border-right: 2px solid #000022;
  	border-radius: 12px;
  	color: #5090c0;
  	background: #203080;
  }









  #editadrbook {
  	position: absolute;
  	left: 10px; top: 240px; bottom: 20px; right: 10px;
  	background: #f0fff0;
  	border: 3px blue solid;
  	z-index: 50;
  	font-family: verdana;
  	font-size: 26px;
  	font-weight: bold;
  	color: #000030;
  	padding-left: 15px;
  	padding-top: 5px;
  	visibility: hidden;
  }
  #ablist {
  	position: absolute;
  	left: 30px; right: 30px; top: 50px; bottom: 220px;
  	overflow: auto;
  }
  .abblock {
  	position: relative;
  	left: 0; right: 0; height: 48px;
  	margin-bottom: 8px;
  	background: #e0f0e0;
  }
  .abbwal {
  	position: absolute;
  	left: 0; top: 3px; right: 0;
  	font-family: "Lucida Console";
  	font-size: 13px;
  	color: #603000;
  }
  .abnc {
  	position: absolute;
  	left: 0; top: 18px; right: 100px;
  }
  .abbname {
  	position: absolute;
  	left: 0; top: 0; width: 100%;
  	font-family: "Lucida Console";
  	font-size: 16px;
  	padding: 3px;
  	color: #000000;
  	border: 1px solid #603000;
  }
  .abbsave {
  	position: absolute;
    right: 50px; top: 8px;
  }
  .abbdel {
  	position: absolute;
    right: 5px; top: 8px;
  }
  #nab {
  	position: absolute;
  	left: 180px; right: 140px; bottom: 90px;
  }
  #abnewwal {
  	position: absolute;
  	left: 0px; right: 0px; bottom: 42px;
  	width: 100%; height: 26px;
  	padding: 3px;
  	font-family: "Lucida Console";
  	font-size: 22px;
  	color: #000050;
  	border: 1px solid black;
  }
  #abnewname {
  	position: absolute;
  	left: 0px; right: 0px; bottom: 0px;
  	width: 100%; height: 26px;
  	padding: 3px;
  	font-family: "Lucida Console";
  	font-size: 22px;
  	color: #000050;
  	border: 1px solid black;
  }
  .eatit {
  	position: absolute;
  	left: 0; width: 170px;
  	text-align: right;
  	font-size: 16px;
  }
  #aeadd {
  	position: absolute;
  	right: 50px; bottom: 90px;
  	font-size: 18px;
  }
  #aeerr {
  	position: absolute;
  	left: 190px; bottom: 65px;
  	font-family: Verdana;
  	font-size: 16px;
  	color: red;
  	font-weight: bold;
  }
  #aeok {
  	position: absolute;
  	right: 30px; bottom: 15px;
  }


  $ZOOMCSS

```

---

- `wallet/wallet.js`:
```javascript

  var wserver = 'ws://127.0.0.1:$PORT';
  var connected = 0;
  var beenconnected = 0;
  var activewallet = "";
  var passbusy = 0;
  var wallets = {};
  var eabmode = 0;
  var solutionFound=0;
  var wins=0;
  var lost=0;
  var miningstart=1;
  var mtime=Date.now()/1000;
  var miningwallet;

  function chatout(txt) {
    var st=document.getElementById('status');
    st.innerHTML = st.innerHTML + "<br />" + txt;
    st.scrollTop=st.scrollHeight;
  }
  
  function wininfo(){
    var avgwin=(wins+lost) ? Math.floor((100/(wins+lost))*wins*100)/100 : 0;
    if(document.getElementById('coinwon')) document.getElementById('coinwon').innerHTML="("+avgwin+"%) "+wins+" of "+(wins+lost);
  }
  
  function mineout(txt) {
    if ((/New challenge:/gi).test(txt)) {
      mtime=Date.now()/1000;
      var sd=document.getElementById('minediff');
      var arg = txt.replace('New challenge: ','').split(' ');
      var cha={
        coin: arg[2],
        diff: arg[5],
        rewa: arg[8],
        leng: arg[11],
        hint: arg[14].split('')
      };
      cha.hint.sort();
      drawDiff(Number(cha.diff));
      drawCoin(0);
      sd.innerHTML =
      '<table cellspacing=0 cellpadding=0 border=0 id="cointable">'+
        '<tr><th>Reward:</th><td id="coinreward">'+cha.rewa+'</td><th>Won:</th><td id="coinwon"></td></tr>'+
        '<tr><th>Coincount:</th><td id="coincount">'+cha.coin+'</td><th>Fh/s:</th><td id="coinfhs">0</td></tr>'+
        '<tr><th>Difficulty:</th><td id="coindiff" title="'+cha.diff+'">'+kstr(cha.diff)+'</td><th>Mined:</th><td id="coinprc">0%</td></tr>'+
        '<tr><th>Length:</th><td id="coinlength">'+cha.leng+'</td><th>Sec:</th><td id="coinsec">0</td></tr>'+
        '<tr><th>Hints:</th><td id="coinhint">'+cha.hint.length+'</td><td colspan="2">'+cha.hint.join(',')+'</td></tr>'+
      '</table>';
      if(solutionFound || miningstart) { solutionFound=0; miningstart=0 }
      else{
        var st=document.getElementById('mineoutput');
        st.innerHTML += "<br><font color='red'> Lost This Round :-/ </font>";
        lost++;
        addStat(0);
        wininfo();
      }
    }
    else if ((/Speed:/gi).test(txt)) {
      var cp=document.getElementById('coinprc');
      var cs=document.getElementById('coinsec');
      var cf=document.getElementById('coinfhs');
      var sd=document.getElementById('minespeed');
      var mtm=Date.now()/1000;
      var sec=Math.floor(mtm-mtime);
      sd.innerHTML = txt.replace('Speed: ','');
      var fhs=drawSpeed(sd.innerHTML);
      timeCoin(sec);
      cs.innerHTML = sec;
      cf.innerHTML = kstr(fhs[0]);
      cp.innerHTML = fhs[1]+'%';
    }
    else if ((/Found solution/gi).test(txt)) {
      var st=document.getElementById('mineoutput');
      st.innerHTML += "<br>" + txt;
      wins++;
      wininfo();
      solutionFound=1;
      addStat(1);
    }
    else{
      wininfo();
      var st=document.getElementById('mineoutput');
      st.innerHTML += "<br>" + txt;
      var lines=(st.innerHTML+"").split('<br>');
      if (lines.length>10) {
        lines.shift();
        st.innerHTML = lines.join("<br>");
      }
      st.scrollTop=st.scrollHeight;
    }
  }

function kstr (num) {
  var nl=(num+"").split('');
  var ni=0,os="";
  for(var i=nl.length-1;i>=0;i--){
    os=nl[i]+os;
    ni++; if(ni == 3 && i>0){ ni=0; os="."+os }
  }
  return os
}
var discon=0;
  function connect() {
    if ("WebSocket" in window) {
      chatout("** WebSockets supported ..<br />** Opening WebSocket on " + wserver + " ..");
    } else if (window.MozWebSocket) {
      chatout("*** WebSockets supported (Mozilla) ..<br />** Opening WebSocket on " + wserver + " ..");
      window.WebSocket=window.MozWebSocket;
    } else {
      chatout("** WebSockets NOT supported !! You won't be able to use this software in this brwoser! Upgrade your browser!!!!");
      return
    }
    socket = new WebSocket(wserver);
    socket.onopen = function() {
      chatout("** Connected to the WebSocket Server");
      connected=1; beenconnected=1;
      socket.send('init');
      document.getElementById('powerbutton').style.background='rgba(127,255,127,0.6)';
    }
    socket.onmessage = function(evt) {
      // arg is usally the time !!!!
      var ml=evt.data.split(" ");
      var target=ml.shift(); var arg=ml[0]; var par=ml[1]; var txt=ml.join(" ");
      if (target == 'status') {
      	chatout(txt)
        if(txt.indexOf("Disconnected from node") !== -1){
          discon=1
        }
        if (discon && txt.indexOf("Connected to node") !== -1 && miningwallet){
          discon=0;
          chatout('* Restarting miner for wallet '+miningwallet+'.');
          startminer(miningwallet);
        } 
      }
      else if (target == 'miner') {
        mineout(txt)
      }
      else if (target == 'mining') {
        var msg;try{eval('msg='+txt);}catch(e){alert(e);return};
        mineout(
          "New challenge:"+
          " Coincount = "+msg.data.coincount+
          " Difficulty = "+msg.data.diff+
          " Reward = "+msg.data.reward+
          " Len = "+msg.data.length+
          " Hints = "+msg.data.hints
        );
        mineout('Already running attached Miner');
        if(mnh==null||mnh > msg.size[0]) mnh=msg.size[0];
        if(mxh==null||mxh < msg.size[1]) mxh=msg.size[1];
        startminer(msg.wallet);
        miningwallet=msg.wallet;
      }
      else if (target == 'node') {
      	setnode(arg)
      }
      else if (target == 'getpass') {
      	document.getElementById('graybg').style.visibility='visible';
      	document.getElementById('passbox').style.visibility='visible';
      	document.getElementById('wachtwoord').focus();
      	passbusy=1
      }
      else if (target == 'passok') {
      	document.getElementById('graybg').style.visibility='hidden';
      	document.getElementById('passbox').style.visibility='hidden';
      	passbusy=0
      }
      else if (target == 'passinvalid') {
      	document.getElementById('passerr').innerHTML='Invalid password. Please try again';
      }
      else if (target == 'addwallet') {
      	var wallet=ml.shift(); var name=ml.join(" ");
      	addwallet(wallet,name);
        activatewallet(wallet);
      }
      else if (target == 'actwal') {
      	activatewallet(arg)
      }
      else if (target == 'balance') {
      	setbalance(arg,par)
      }
      else if (target == 'adrbook') {
      	var wallet=ml.shift(); var name=ml.join(" ");
      	adrbook(wallet,name)
      }
      else if (target == 'transerr') {
      	transerr(txt)
      }
      else if (target == 'transok') {
        transok(arg,par,ml[2],ml[3])
      }
      else if (target == 'transtotal') {
      	document.getElementById('transtotal').innerHTML=arg
      }
      else if (target == 'powerdownnow'){
        window.close();
      }
    }
    socket.onclose = function() {
      if (connected) {
        document.getElementById('powerbutton').style.background='rgba(255,0,0,0.5)';
        chatout("** Lost connection to the WebSocket Server. Please refresh.");
      }
      gorefresh()
    }
    socket.onerror = function() {
      if (connected) {
        chatout("** WebSocket Server Error. Please refresh.");
      } else {
      	chatout("** The WebSocket Server is offline. Please restart FCC.")
      }
      document.getElementById('powerbutton').style.background='rgba(255,0,0,0.5)';
      gorefresh()
    }
  }
  function start() {
  	connect();
    $AUTOSTART
  }
  function powerDownWallet(){
    socket.send('powerdown');
  }
  function savechatnick(nick){
    socket.send('savechat nick '+nick);
  }
  function savechatident(ident){
    socket.send('savechat ident '+ident);
  }
  function savechatauto(checked){
    socket.send('savechat auto '+(checked?"1":"0"));
  }
  function savechatzoom(zoom){
    socket.send('savechat zoom '+zoom);
    chatzoom()
  }
  function gorefresh() {
  	document.getElementById('graybg').style.visibility='visible';
  	document.getElementById('refresh').style.visibility='visible';
  }
  function checkenter(e,id) {
    if (e.which == 13 || e.keyCode == 13) { 
      var obj = document.getElementById(id);
      obj.select(); obj.focus()
    }
  }
  function checksubmit(e,id) {
    if (e.which == 13 || e.keyCode == 13) { 
      var obj = document.getElementById(id);
      obj.click();
    }
  }
  function checkdigit(e,id) {
  	var txt=document.getElementById(id).value;
  	txt = txt.replace(",",".");
  	txt = txt.replace(/[^0-9.]/g,"");
  	document.getElementById(id).value=txt
  }
  function checkhexpaste(id) {
  	var txt=document.getElementById(id).value;
  	txt = txt.toUpperCase();
  	txt = txt.replace(/[^0-9A-F]/g,"");
  	document.getElementById(id).value=txt
  }
  function checkhex(e,id) {
  	checkhexpaste(id)
  }
  function checkpass() {
  	var pass = document.getElementById("wachtwoord").value;
  	socket.send('pass ' + pass)
  }
  function passprotect() {
  	if (passbusy) { return }
   	document.getElementById('graybg').style.visibility='visible';
   	document.getElementById('newpassbox').style.visibility='visible';
  	document.getElementById('newpasserr').innerHTML="";
   	document.getElementById('newpass').focus();
   	document.getElementById('newpass').select();
  }
  function cancelnewpass() {
   	document.getElementById('graybg').style.visibility='hidden';  	
   	document.getElementById('newpassbox').style.visibility='hidden';  	
  }
  function setnewpass() {
  	document.getElementById('newpasserr').innerHTML="";
   	var pass=document.getElementById('newpass').value;
   	if (pass != '') {
   		var vld=document.getElementById('newpassvld').value;
   		if (vld != pass) {
   			document.getElementById('newpasserr').innerHTML='The passwords are not the same'
   		}
   		else {
        socket.send("newpass " + pass);
      	document.getElementById('graybg').style.visibility='hidden';
      	document.getElementById('newpassbox').style.visibility='hidden';
   		}
   	}
   	else {
   		document.getElementById('newpasserr').innerHTML='No password given'
   	}
  }
  function setnode(node) {
  	document.getElementById('node').innerHTML="Node: " + node;
  }
  function addwallet(wallet,name) {
    var wal=document.createElement("DIV");
    wal.id='R' + wallet;
    wal.classList.add("rwal");
    document.getElementById("wallets").appendChild(wal);
    
    var obj=document.createElement("DIV");
    obj.id='W' + wallet;
    obj.classList.add("iwal");
    obj.classList.add("muis");
    obj.innerHTML=(name != "" ? name + " (" + wallet + ")" : wallet);
    obj.addEventListener("click",function() { activatewallet(this.id.substring(1)) },false);
    wal.appendChild(obj);

    var obj=document.createElement("IMG");
    obj.id='C' + wallet;
    obj.src="image/clipboard.png";
    obj.width='32px';
    obj.classList.add("cwal");
    obj.classList.add("muis");
    obj.addEventListener("click",function() { copywal(this.id.substring(1)) },false);
    wal.appendChild(obj);

  	wallets[wallet]=name
  }
  function activatewallet(wallet) {
  	document.getElementById("wallet").innerHTML=wallet;
  	document.getElementById("from").innerHTML="[ no name ] (" + wallet + ")";
  	document.getElementById("walname").style.visibility='visible';
	  document.getElementById("copywallet").style.visibility='visible';
	  document.getElementById("savewalbut").style.visibility='visible';
    if (activewallet != "") {
      document.getElementById(activewallet).style.background='#cceeff';
      document.getElementById(activewallet).style.color='#2060a0';
    }
  	socket.send('balance ' + wallet);
  	var wobj = 'W' + wallet;
  	document.getElementById(wobj).style.background='#20aa60';
  	document.getElementById(wobj).style.color='#ffffff';
  	var wname=document.getElementById(wobj).innerHTML;
  	var ws=wname.split(" "); ws.pop(); wname=ws.join(" ");
  	document.getElementById("walname").value=wname;
  	if (wname) {
	  	document.getElementById("from").innerHTML=wname + " (" + wallet + ")";
  	}
  	var i; var cwo=document.getElementById("change"); var cwl=cwo.options;
  	for (i=cwl.length-1;i>=0;i--) { cwo.remove(i) }
  	var cho=document.createElement("OPTION");
    cho.value=wallet;
    cwo.add(cho);
    cwo.selectedIndex=0;
    var wl=document.getElementById("wallets").children;
    for (i=1;i<wl.length;i++) {
    	if (wl[i].id.substr(1) != wallet) {
      	var cho=document.createElement("OPTION");
        cho.value=wl[i].id.substr(1);
        cho.text=wl[i].id.substr(1);
        cwo.add(cho);
    	} else {
    		cwo.options[0].text=wl[i].id.substr(1);
    	}
    }
    document.getElementById('pickaxe').style.display = (new RegExp(wallet)).test(document.getElementById('minewallet').innerHTML) ? 'block':'none';
  	activewallet=wobj
  }
  function setbalance(balance,wallet) {
  	if (document.getElementById("wallet").innerHTML == wallet) {
  	  document.getElementById("balance").innerHTML=balance;
     	  showdelwal(balance)
  	}
  }
  function getwallet() {
  	return document.getElementById("wallet").innerHTML
  }
  function createwallet() {
  	if (passbusy) { return }
  	socket.send("createwallet")
  }
  function openchat() {
    var obj=document.getElementById('chatframe');
    var n=document.getElementById('chatnick').value;
    var p=document.getElementById('identpass').value;
    document.getElementById('chatcont').style.border='0px';
    var c="http://chat.lichtsnel.nl?channel=crypto" + ( n ? '&autologin=1&nick='+escape(n)+( p ? '&pass='+escape(p) : '') : '');
    if (obj) {
      if(confirm('Reopen the Chat Window?')){
        obj.src=c;
      }
    } else {
      document.getElementById('openchat').innerHTML='&nbsp;&nbsp;Reopen Chatbox';
      document.getElementById('chatzoom').style.display='block';
      var ct=document.getElementById('chatcont');
      obj=document.createElement("IFRAME");
      obj.id='chatframe';
      obj.src=c;
      obj.scrolling="no";
      ct.appendChild(obj);
      chatzoom()
    }
  }
  function chatzoom() {
    var cz=document.getElementById('chatzoom'), zm=cz.options[cz.selectedIndex].value, zp=(100/(zm/100));
    var cf=document.getElementById('chatframe');
    if(cf){
      if(cf.classList.length>0) cf.classList.remove(cf.classList.item(0));
      cf.classList.add("zm"+zm);
      cf.style.width=zp+'%';
      cf.style.height=zp+'%';
    }
  }
  function savewalname() {
  	var name=document.getElementById("walname").value;
  	var wallet=getwallet();
  	if (wallet.length == 68) {
  	  socket.send("setname " + wallet + " " + name);
  	  wallets[wallet]=name
  	}
  	var wid="W" + wallet;
  	document.getElementById(wid).innerHTML=name + " (" +wallet + ")";
  }
  function copywal(w) {
  	var txt=w||document.getElementById("wallet").innerHTML;
  	if (window.clipboardData && window.clipboardData.setData) {
      // IE specific code path to prevent textarea being shown while dialog is visible.
      clipboardData.setData("Text", txt);
    }
    else if (document.queryCommandSupported && document.queryCommandSupported("copy")) {
      var textarea = document.createElement("textarea");
      textarea.textContent = txt;
      textarea.style.position = "fixed";  // Prevent scrolling to bottom of page in MS Edge.
      document.body.appendChild(textarea);
      textarea.select();
      try {
        document.execCommand("copy");  // Security exception may be thrown by some browsers.
    	  document.getElementById("copied").innerHTML="Copied to clipboard";
      } catch (ex) {
    	  document.getElementById("copied").innerHTML="NOT copied. " + ex;
      } finally {
        document.body.removeChild(textarea);
      }
    }
  	window.setTimeout(function(){ document.getElementById("copied").innerHTML="";},1750)
  }
  function showdelwal(balance) {
  	if (balance == '0.00000000') {
  	  document.getElementById("delwalbut").style.visibility='visible'
  	}
  	else {
  	  document.getElementById("delwalbut").style.visibility='hidden'  		
  	}
  }
  function delwal() {
  	if (window.confirm("ARE YOU SURE ?\n\nAlthough this wallet is now empty,\nif you have ever published it,\nit still may receive money in the future.\n\nOnly confirm if you have never published this wallet.")) {
  		var wallet=getwallet();
  		socket.send('delwallet ' + wallet);
  	  document.getElementById("delwalbut").style.visibility='hidden';
  	  document.getElementById("copywallet").style.visibility='hidden';
  	  document.getElementById("savewalbut").style.visibility='hidden';
  	  document.getElementById("wallet").innerHTML="[none]";
  	  document.getElementById("from").innerHTML="[none]";
    	document.getElementById("walname").style.visibility='hidden';
  	  document.getElementById("balance").innerHTML="";
  	  var obj=document.getElementById("R" + wallet);
    	document.getElementById("wallets").removeChild(obj);
    	activewallet="";
    	var wlist=document.getElementById("wallets").children;
    	if (wlist.length>1) {
        activatewallet(wlist[1].id.substr(1))
      }
  	}
  }
  function startminer(w) {
    var wallet = w||getwallet();
    document.getElementById('minewallet').innerHTML=wallet + (wallets[wallet] ? '<br>'+wallets[wallet]:'');
    document.getElementById('minerrunning').style.display='block';
    document.getElementById('minerstopped').style.display='none';
    document.getElementById('miner').style.display='block';
    document.getElementById('diffaxe').style.display = 'block';
    document.getElementById('pickaxe').style.display = (new RegExp(document.getElementById('wallet').innerHTML)).test(document.getElementById('minewallet').innerHTML) ? 'block':'none';
    mineout('Started Miner on '+wallet.substr(0,16)+'... !');
    miningwallet=wallet;
    socket.send('startminer ' + wallet)
  }
  function stopminer() {
    miningstart=1;
    document.getElementById('minewallet').innerHTML="";
    document.getElementById('minerrunning').style.display='none';
    document.getElementById('minerstopped').style.display='block';
    document.getElementById('miner').style.display='none';
    document.getElementById('diffaxe').style.display = 'none';
    document.getElementById('pickaxe').style.display = 'none';
    mineout('Miner stopped!');
    socket.send('stopminer')
  }
  function transerr(txt) {
  	if (eabmode) {
    	document.getElementById('aeerr').innerHTML=txt
  	} else {
  	  document.getElementById('transerr').innerHTML=txt
  	}
  }
  function adrbook(wallet,name) {
  	var option = document.createElement("option");
    option.text = name; option.value=wallet;
    document.getElementById('adrbook').add(option);
    wallets[wallet]=name
  }
  function setadrbook() {
  	var idx=document.getElementById('adrbook').selectedIndex;
  	var list=document.getElementById('adrbook').options;
  	var wallet=list[idx].value;
  	var name=list[idx].innerHTML;
  	document.getElementById('to').value=wallet;
  	document.getElementById('newadrbook').value=name;
  }
  function saveadrbook() {
  	transerr("");
  	var to=document.getElementById('to').value;
  	var name=document.getElementById('newadrbook').value;
  	if ((to != '') && (name != '')) {
  		socket.send('adrbook ' + to + ' ' + name);
    	document.getElementById('newadrbook').value=""
  	} else {
    	transerr("Please fill in a wallet-address and the name of the recipient")
  	}
  }
  function addtrans() {
  	transerr("");
  	var amount=document.getElementById('amount').value;
  	var fee=document.getElementById('fee').value;
  	var to=document.getElementById('to').value;
    if ((to != "") && (amount != "0.00000000")) {
    	socket.send('checktrans ' + to + ' ' + amount + ' ' + fee)
  	} else {
    	transerr("Please fill in an amount and the wallet-address of the recipient")
    }
  }
  function transok(nr,amount,fee,total) {
    var tout=document.createElement("DIV");
    tout.classList.add("transoutitem");
    tout.id='transout_' + nr;
    var wallet=document.getElementById('to').value;
    var name="[ No name ]";
    if (wallets[wallet] != null) { name=wallets[wallet] }

    var wout=document.createElement("DIV");
    wout.classList.add("walletout");
    wout.innerHTML=name + ' (' + wallet + ')';
    tout.appendChild(wout);

    var taout=document.createElement("DIV");
    taout.classList.add("totalout");
    taout.innerHTML=total;
    tout.appendChild(taout);

    var aout=document.createElement("DIV");
    aout.classList.add("amountout");
    aout.innerHTML="Amount: " + amount;
    tout.appendChild(aout);

    var fout=document.createElement("DIV");
    fout.classList.add("feeout");
    var spacing="";
    var ldec=amount.split("."); var dec=ldec[0]; var dn=dec.length;
    var lfdec=fee.split("."); var fdec=lfdec[0]; var dfn=fdec.length;
    while (dn>dfn) { spacing = spacing + '&nbsp;'; dn-- }
    fout.innerHTML="&nbsp;&nbsp;&nbsp;Fee: " + spacing + fee;
    tout.appendChild(fout);

    var dout=document.createElement("IMG");
    dout.id="delout_" + nr;
    dout.src="image/del.png";
    dout.height="26";
    dout.classList.add('delout');
    dout.classList.add('muis');
    dout.addEventListener("click",delout,false);
    tout.appendChild(dout);

    document.getElementById('transoutbox').appendChild(tout);
  }
  function delout(e) {
    var id=e.target.id; var lid=id.split("_"); var nr=lid[1];
    var obj=document.getElementById('transout_' + nr);
    document.getElementById('transoutbox').removeChild(obj);
    socket.send('deltrans ' + nr)
  }
  function transfer() {
  	var total=document.getElementById('transtotal').innerHTML;
  	var amount=document.getElementById('balance').innerHTML;
  	if (total == '0.00000000') {
  		transerr("No transactions to send")
  	} else if (parseFloat(amount) < parseFloat(total)) {
  		transerr("This wallet has insufficient funds to make this transaction")
  	} else {
    	document.getElementById('graybg').style.visibility='visible';
    	var wallet=document.getElementById("wallet").innerHTML;
    	var wbar=document.getElementById("W" + wallet).innerHTML;
    	document.getElementById("tcfrom").innerHTML=wbar;
    	document.getElementById("tctotal").innerHTML=total;
    	var chwal=document.getElementById('change');
    	document.getElementById("tcchange").innerHTML=chwal.options[chwal.selectedIndex].text;
     	var list=document.getElementsByClassName("tcoutblock");
     	var cf=document.getElementById("tcout");
     	var i;
     	for (i = list.length-1; i>=0; i--) {
        cf.removeChild(list[i])
      }
      var oblist=document.getElementsByClassName("transoutitem");
     	for (i = 0; i < oblist.length; i++) {
        var wobj=oblist[i].children[0];
        var aobj=oblist[i].children[2];
        var fobj=oblist[i].children[3];
        var vo=document.createElement("DIV");
        vo.classList.add("tcoutblock");
        var vow=document.createElement("DIV");
        vow.classList.add("tcoutwal");
        vow.innerHTML=wobj.innerHTML;
        vo.appendChild(vow)
        var voa=document.createElement("DIV");
        voa.classList.add("tcoutamount");
        voa.innerHTML=aobj.innerHTML.split(" ")[1];
        vo.appendChild(voa)
        var vof=document.createElement("DIV");
        vof.classList.add("tcoutfee");
        vof.innerHTML=fobj.innerHTML.split(" ")[1];
        vo.appendChild(vof);
        cf.appendChild(vo)
      }
     	document.getElementById('transconfirm').style.visibility='visible';
  	}
  }
  function tccancel() {
   	document.getElementById('transconfirm').style.visibility='hidden';
   	document.getElementById('graybg').style.visibility='hidden';
  }
  function tcok() {
  	tccancel();
   	var cf=document.getElementById("transoutbox");
    var list=document.getElementsByClassName("transoutitem");
   	var i;
   	for (i = 0; i < list.length; i++) {
      cf.removeChild(list[i])
    }
  	document.getElementById('amount').value='0.00000000';
  	document.getElementById('fee').value='0.5';
  	document.getElementById('to').value="";
  	document.getElementById('transtotal').innerHTML='0.00000000';
  	document.getElementById('adrbook').selectedIndex=0;
  	var wallet=getwallet(); var cobj=document.getElementById('change');
  	var chwal=cobj.options[cobj.selectedIndex].value;
  	socket.send('transfer ' + wallet + ' ' + chwal)
  }
  function aeerase() {
  	var cf=document.getElementById("ablist");
    var list=cf.children;
   	var i;
   	for (i = list.length-1; i>=0; i--) {
      cf.removeChild(list[i])
    }
  }
  function aefill() {
  	var list=document.getElementById('adrbook').options;
  	var i; var abl=document.getElementById("ablist");
  	for (i=1;i<list.length;i++) {
  		var wallet=list[i].value; var name=list[i].text;
  		var block=document.createElement("DIV");
      block.classList.add("abblock");
      var bw=document.createElement("DIV");
      bw.id='bw_' + i;
      bw.classList.add("abbwal");
      bw.innerHTML=wallet;
      block.appendChild(bw);
      var bnc=document.createElement("DIV");
      bnc.classList.add("abnc");
      var bn=document.createElement("INPUT");
      bn.id='bn_' + i;
      bn.classList.add("abbname");
      bn.value=name;
      bn.addEventListener('change',changeadrbook,false);
      bnc.appendChild(bn);
      block.appendChild(bnc);
      var bs=document.createElement("IMG");
      bs.id='bs_' + i;
      bs.classList.add("abbsave");
      bs.classList.add("muis");
      bs.src="image/save.png";
      bs.height="40";
      bs.addEventListener('click',changeadrbook,false);
      block.appendChild(bs);
      var bd=document.createElement("IMG");
      bd.id='bd_' + i;
      bd.classList.add("abbdel");
      bd.classList.add("muis");
      bd.src="image/del.png";
      bd.height="40";
      bd.addEventListener('click',deladrbook,false);
      block.appendChild(bd);
      abl.appendChild(block)
  	}  	
  }
  function changeadrbook(e) {
  	var id=e.target.id; var ids=id.split('_');
    var wallet=document.getElementById('bw_' + ids[1]).innerHTML;
    var name=document.getElementById('bn_' + ids[1]).value;
    document.getElementById('adrbook').options[ids[1]].text=name;
   	wallets[wallet]=name;
    socket.send("chadrbook " + wallet + ' ' + name)
  }
  function deladrbook(e) {
  	var id=e.target.id; var ids=id.split('_');
    var wallet=document.getElementById('bw_' + ids[1]).innerHTML;
    var name=document.getElementById('bn_' + ids[1]).value;
    if (confirm("Are you sure you want to delete wallet '" + name + "'\n(" + wallet + ") ?")) {
      socket.send('deladrbook ' + wallet);
      document.getElementById("adrbook").remove(ids[1]);
      aeerase(); aefill()
    }
  }
  function adrbookinterface() {
  	eabmode=1; transerr("");
  	document.getElementById('abnewwal').value="";
  	document.getElementById('abnewname').value="";
  	aefill();
   	document.getElementById('graybg').style.visibility='visible';
   	document.getElementById('editadrbook').style.visibility='visible';
  }
  function aeok() {
  	eabmode=0; aeerase();
   	document.getElementById('editadrbook').style.visibility='hidden';  	
   	document.getElementById('graybg').style.visibility='hidden';
  }
  function aeadd() {
  	transerr("");
  	var adr=document.getElementById('abnewwal').value;
  	var name=document.getElementById('abnewname').value;
  	if ((adr != '') && (name != '')) {
  		socket.send('adrbook ' + adr + ' ' + name);
  	} else {
    	transerr("Please fill in a wallet-address and the name of the recipient")
  	}
  }
  
  // canvas

  function drLine (ctx,x1,y1,x2,y2,w,c){
    ctx.lineWidth=w;
    ctx.strokeStyle=c;
    ctx.beginPath();
    ctx.moveTo(x1,y1);
    ctx.lineTo(x2,y2);
    ctx.stroke();
  }

  function clearCtx(ctx,c){
    if(c){
      ctx.fillStyle=c;
      ctx.fillRect(0,0,1000,100);
    }else{
      ctx.clearRect(0,0,1000,100);
    }
  }

  function mineCtx(){
    return document.getElementById('minecanvas').getContext('2d')
  }
  function diffCtx(){
    return document.getElementById('diffcanvas').getContext('2d')
  }
  function coinCtx(){
    return document.getElementById('coincanvas').getContext('2d')
  }

  // mining canvas

  var mineStat=[];
  var mnh=null, mxh=null;

  function clearMine(c){
    clearCtx(mineCtx(),c)
  }

  function addStat(fhs,fpr){
    if(fpr == undefined){ // Hits
      if(fhs) clearMine('rgba(0,255,0,1)');
      else    clearMine('rgba(255,0,0,1)');
      mineStat.push([fhs]);
    }
    // fHs
    else mineStat.push([fhs,fpr]);
    truncStat();
  }

  function truncStat(){
    while(mineStat.length>1000) mineStat.shift();
  }
  
  function drawSpeed(speed){
    var fhs,fpr;
    if(speed){
      var s=speed.split(' '); // 33750,Fhash/sec,(7.67,%)
      fhs=Number(s[0]),fpr=Number(s[2].replace('(',''));
      addStat(fhs,fpr);
    }
    mnh = null; mxh = null;
    for (var i=0;i<mineStat.length;i++) {
      if(mineStat[i][1] != undefined){
        if(mnh == null || mnh>mineStat[i][0]) mnh=mineStat[i][0];
        if(mxh == null || mxh<mineStat[i][0]) mxh=mineStat[i][0];
      }
    }
    var dist=Math.abs(mxh-mnh);
    clearMine(mineStat[mineStat.length-1][1] == undefined ? mineStat[mineStat.length-1][0] ? 'rgba(0,255,0,1)' : 'rgba(255,0,0,0)' : 'rgba(0,0,0,0.2)');
    var ctx=mineCtx();
    var l,t,c,pl=null,pt=null;
    for(var i=1,j=mineStat.length-1;i<=mineStat.length;i++,j--){
      l=1000-i;
      t=90 - (mineStat[j][1] == undefined ? 90 : ((80/dist)*(mineStat[j][0]-mnh)) );
      c=(255/100) * (mineStat[j][1] == undefined ? 100 : ((100/dist)*(mineStat[j][0]-mnh)) );
      var col = mineStat[j][1] == undefined ? mineStat[j][0] ? '#00aa00' : '#aa0000' : "rgb(255,"+Math.round((255*0.4)+(c*0.6))+",0)";
      drLine(ctx,pl==null?l:pl,mineStat[j][1] == undefined ? 100 : pt==null ? t : pt,l,t,3,col);
      if(mineStat[j][1] != undefined ){ pl=l; pt=t }
    }
    return [fhs,fpr];
  }

  // Difficulty Canvas

  var diffStat=[];
  var mndh=null, mxdh=null;

  function cleanDiff(){
    diffCtx().clearRect(0,0,2000,100);
  }

  function addDiff(diff){
    diffStat.push(Number(diff));
    truncDiff();
  }

  function truncDiff(){
    while(diffStat.length>500) diffStat.shift();
  }
  
  function drawDiff(diff){
    if(diff) addDiff(diff);
    for (var i=0;i<diffStat.length;i++) {
      if(diffStat[i] != undefined){
        var d=Number(diffStat[i]);
        if(mndh == null || mndh>d) mndh=d;
        if(mxdh == null || mxdh<d) mxdh=d;
      }
    }
    var dist=diffStat.length<2 || !(mxdh-mndh) ? 1 : Math.abs(mxdh-mndh);
    //console.log(dist+mndh);
    cleanDiff();
    var ctx=diffCtx();
    var l,t,c,d,pl=0,pt=null;
    for(var i=1,j=0;i<=diffStat.length;i++,j++){
      l=(i-1)*(2000/coinStat.length);
      d=(diffStat[j]-mndh);
      t=90 - (diffStat[j] == undefined ? 80 : ((80/dist)*d) );
      c=(255/100) * (diffStat[j] == undefined ? 0 : ((100/dist)*d) );
      var col = diffStat[j] == undefined ? 'red' : "rgba("+Math.round((255*0.2)+(c*0.4))+",0,255,0.8)";
      drLine(ctx,pl==null?l:pl,pt==null?t:pt,l,t,3,col);
      pl=l;
      pt=t;
    }
  }

  // Coinbase Canvas

  var coinStat=[];
  var mnch=null, mxch=null;

  function cleanCoin(){
    coinCtx().clearRect(0,0,2000,100);
  }

  function addCoin(time){
    coinStat.push(Number(time));
    truncCoin();
  }

  function truncCoin(){
    while(coinStat.length>500) coinStat.shift();
  }
  
  function timeCoin(time){
    if(coinStat.length) coinStat[coinStat.length-1]=time; else coinStat[0]=time;
    drawCoin();
  }

  function drawCoin(time){
    if(time!=undefined) addCoin(time);
    for (var i=0;i<coinStat.length;i++) {
      if(coinStat[i] != undefined){
        var d=Number(coinStat[i]);
        if(mnch == null || mnch>d) mnch=d;
        if(mxch == null || mxch<d) mxch=d;
      }
    }
    var dist=Math.abs(mxch-mnch);
    //console.log(dist+mnch);
    cleanCoin();
    var ctx=coinCtx();
    var l,t,c,d,pl=0,pt=null;
    for(var i=1,j=0;i<=coinStat.length;i++,j++){
      l=(i*(2000/coinStat.length));
      d=(coinStat[j]-mnch);
      t=90 - (coinStat[j] == undefined ? 0 : ((80/dist)*d) );
      c=(255/100) * (coinStat[j] == undefined ? 0 : ((100/dist)*d) );
      var col = coinStat[j] == undefined ? 'red' : "rgba(255,0,"+Math.round((255*0.2)+(c*0.4))+",0.8)";
      drLine(ctx,pl==null?l:pl,pt==null?t:pt,l,t,3,col);
      pl=l;
      pt=t;
    }
  }

```

- `wallet/wallet.port`:
```text
5115
```

---

- `FCC/leaf.pm`:
```perl
#!/usr/bin/perl

package FCC::leaf;

#############################################################
#                                                           #
#     FCC Leaf v2.01                                        #
#                                                           #
#    (C) 2019 Chaosje, Domero                               #
#    Leaves are less strict, the node will check all        #
#                                                           #
#############################################################

use strict;
no strict 'refs';
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '2.1.1';
@ISA         = qw(Exporter gclient);
@EXPORT      = qw();
@EXPORT_OK   = qw(startleaf leafloop outnode closeleaf balance solution sign transfer);

use JSON;
use gerr qw(error);
use gfio 1.10;
use Digest::SHA qw(sha256_hex sha512_hex);
use IO::Socket::INET;
use gclient 7.7.3;
use gserv 4.3.2;
use Time::HiRes qw(gettimeofday usleep);
use FCC::global 2.3.1;
use FCC::wallet 2.1.4 qw(validwallet);
use FCC::fcc 1.2.6;

my $DEBUG = 0;

my $LOOPWAIT = 1000; # be nice, release CPU for other processes
my $FCCFUNCTION='leaf';
my $CALLER;
my $LEAVES=[];
my $LEAFID=0;
my $VERS=join('.',substr($FCCVERSION,0,2)>>0,substr($FCCVERSION,2,2));
my $TRANSID=((int(rand(1000000))+10000)<<20)+int(rand(1000000));

1;

sub startleaf {
  my ($host,$port,$caller,$active,$miner) = @_;
  if (!defined $caller || (ref($caller) ne 'CODE')) { error "Caller-function missing in FCC::leaf::start" }
  $CALLER=$caller;
  if (!$host) { $host='127.0.0.1' }
  if (!$port) { $port=7050 }
  $FCCFUNCTION='leaf'; if ($miner) { $FCCFUNCTION='miner' }
  $LEAFID++;
  my $leaf=gclient::websocket($host,$port,$active,\&handle_leaf);
  if ($leaf->{error}) { print STDOUT "\nError connecting $FCCFUNCTION: $leaf->{error}\n\n"; return $leaf }
  $leaf->{connected}=0;
  $leaf->{leafcaller}=$caller;
  $leaf->{passive}=1;
  $leaf->{leafid}=$LEAFID;
  $leaf->{outbuffer}=[];
  bless($leaf); 
  push @$LEAVES,$leaf;
  return $leaf
}

sub handle_leaf {
  my ($leaf,$command,$data) = @_;
  if (!$data) { $data="" }
  if ($command eq 'init') {
    if (!$leaf->{passive}) {
      # maybe this is a bit too much but enables multiple processes using active leaves within the same run-spece.
      $leaf->{connected}=0;
      $leaf->{leafcaller}=$CALLER;
      $leaf->{fccfunction}=$FCCFUNCTION;
      $leaf->{leafid}=$LEAFID;
      $leaf->{outbuffer}=[];
    } else {
      return
    }
  }
  my $func=$leaf->{leafcaller};
  if (!$func) { $func=$CALLER }
  if ($DEBUG && ($command ne 'loop')) {
    print STDOUT " < [LEAF]: $command - $data\n";
  }
  if ($command eq 'loop') {
  } elsif ($command eq 'input') {
    handleinput($leaf,$data)
  } elsif ($command eq 'error') {
    gclient::wsquit($leaf);
    print STDOUT "Leaf exited with error: $data\n\n";
    &$func($leaf,'disconnect',{ error => $data });
  } elsif ($command eq 'quit') {
    print STDOUT "Lost connection to node: $data\n\n";
    &$func($leaf,'disconnect',{ error => $data });
  } elsif ($command eq 'close') {
    print STDOUT "Lost connection to node: $data\n\n";
    &$func($leaf,'disconnect',{ error => $data });
  } elsif ($command eq 'connect') {
    my ($tm,$ip) = split(/ /,$data);
    $leaf->{connected}=1;
    if ($DEBUG) {
      print STDOUT prtm()."Connected as $leaf->{fccfunction} v$VERS at $leaf->{localip} to $ip\n"
    }
  }
}

################## SYSTEM FUNCTIONS ###########################

sub outnode {
  my ($leaf,$k) = @_;
  if (ref($k) ne 'HASH') {
    error "Not a hash-reference given in FCC::leaf::outnode"
  }
  push @{$leaf->{outbuffer}},$k;
}

sub leafloop {
  # in passive mode.. call this yourself!
  foreach my $leaf (@$LEAVES) {
    if ($leaf->{connected}) {
      if ( $#{$leaf->{outbuffer}} >= 0 ) {
        my $json=JSON->new->allow_nonref;
        my $data=shift @{$leaf->{outbuffer}};
        gclient::wsout($leaf,$json->encode($data));
      }
    }
    $leaf->takeloop()
  }
}

sub closeleaf {
  my ($leaf,$msg) = @_;
  print STDOUT " !! Closing leaf $leaf->{host}:$leaf->{port}\n";
  if (!$msg) { $msg='Closed' }
  my $func=$leaf->{leafcaller};
  &$func($leaf,'terminated', { message => $msg });
  if ($leaf->{connected}) {
    $leaf->wsquit($msg)
  } else {
    $leaf->quit($msg)
  }
}

################## CALLABLE FUNCTIONS #####################################

sub balance {
  my ($leaf,$wallet) = @_;
  if (ref($wallet)) { $wallet=$wallet->{wallet} }
  outnode($leaf,{ command => 'balance', wallet => $wallet })
}

sub transfer {
  my ($leaf,$pubkey,$changewallet,$tolist) = @_;
  # tolist = { wallet, amount(doggy), fee(doggyfee) }
  $TRANSID++;
  outnode($leaf,{ command => 'newtransaction', transid => $TRANSID, pubkey => $pubkey, to => $tolist })
}

sub sign {
  my ($leaf,$transid,$signature) = @_;
  outnode($leaf, { command => 'signtransaction', transid => $transid, signature => $signature })  
}

sub history {
  my ($leaf,$wallet) = @_;
}

sub solution {
  my ($leaf,$wallet,$solhash) = @_;
  outnode($leaf,{ command => 'solution', wallet => $wallet, solhash => $solhash })
}

sub ledgerinfo {
  my ($leaf) = @_;
  outnode($leaf,{ command => 'ledgerinfo' })
}

sub getledgerdata {
  my ($leaf,$pos,$length,$final) = @_;
  if (!$final) { $final=0 }
  outnode($leaf,{ command => 'reqledger', pos => $pos, length => $length, final => $final })
}

################# HANDLE INPUT ########################################

sub handleinput {
  my ($leaf,$data) = @_;
  my $json = JSON->new->allow_nonref;
  my $k=$json->decode($data);
  my $cmd=$k->{command};
  my $func=$leaf->{leafcaller};
  if ($k->{error}) {
    &$func($leaf,'error',{ command => 'error', message => $cmd, error => $k->{error}, available=>$k->{available}, spendable=>$k->{spendable} });
    return
  }
  my $proc="c_$cmd";
  if (defined &$proc) {
    &$proc($leaf,$k)
  } else {
    if (defined $::ILLEGAL_CALLBACK && ref($::ILLEGAL_CALLBACK) eq 'CODE') {
      &$::ILLEGAL_CALLBACK($data);
    } else {
      print STDOUT "Illegal command sent to leaf: [$cmd]\n"
    }
  }
}

sub c_wrong {
  my ($leaf,$data) = @_;
  if (defined $::WRONG_CALLBACK && ref($::WRONG_CALLBACK) eq 'CODE') {
    &$::WRONG_CALLBACK($data);
  } else {
    print STDOUT "Wrong Solution Send: $data\n"
  }
}

sub c_error {
  my ($leaf,$k) = @_;
  print STDOUT "Error: $k->{message}\n";
  outnode($leaf,{ command => 'quit' });
  gclient::quit($leaf);
  exit
}

sub c_hello {
  my ($leaf,$k) = @_;
  outnode($leaf,{ command => 'identify', type => $leaf->{fccfunction}, version => $FCCVERSION });
  my $func=$leaf->{leafcaller};
  &$func($leaf,'response',{ node => "$k->{host}:$k->{port}", version => $k->{version} })
}

sub c_quit {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'disconnect',{ message => $k->{message} });
  $leaf->quit()
}

sub c_balance {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'balance',{ balance => $k->{balance}, wallet => $k->{wallet} })
}

sub c_newtransaction {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  if ($k->{error}) {
    &$func($leaf,'transstatus',{ error => $k->{error}, transid => $k->{transid}, transhash => $k->{transhash} })
  } else {
    &$func($leaf,'sign',{ data => $k->{sign}, transid => $k->{transid} });
  }
}

sub c_signtransaction {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'transstatus',{ error => $k->{error}, transid => $k->{transid}, transhash => $k->{transhash} })
}

sub c_processed {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  if ($k->{error}) {
    &$func($leaf,'transstatus',{ error => $k->{error}, transhash => $k->{transhash} })
  } else {
    &$func($leaf,'transstatus',{ status => 'success', transhash => $k->{transhash}, wallet => $k->{wallet}, amount => $k->{amount}, fee => $k->{fee} })
  }
}

sub c_history {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
#  &$func($k->{wallet},$k->{history})
}

sub c_mine {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'mine',$k)
}

sub c_solution {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'solution',$k)  
}

sub c_ledgerresponse {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'ledgerinfo',$k)
}

sub c_ledgerdata {
  my ($leaf,$k) = @_;
  my $func=$leaf->{leafcaller};
  &$func($leaf,'ledgerdata',$k)
}

# EOF leaf.pm (C) 2018 Chaosje, Domero 
```

---

- `FCC/wallet.pm`:
```perl
#!/usr/bin/perl

package FCC::wallet;

#######################################
#                                     #
#     FCC Wallet                      #
#                                     #
#    (C) 2019 Domero                  #
#                                     #
#######################################

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '2.1.7';
@ISA         = qw(Exporter);
@EXPORT      = qw($WALLETEXISTS $WALLETDIR
                  publichash validatehash createwalletaddress walletexists walletisencoded validwalletpassword
                  newwallet validwallet loadwallet loadwallets savewallet savewallets);
@EXPORT_OK   = qw();

use gfio 1.11;
use gerr 1.02;
use Crypt::Ed25519;
use glib;
use FCC::global 2.2.1;

our $WALLETDIR=".";
our $WALLETEXISTS=&findwallet();

my @WXOR = ();
createtable();

1;

# Wallet structure
#
# offset length  content
#      0      2  '51' - FCC identifier (11 for PTTP)
#      2     64  Public hashkey
#     66      2  Checksum, xor ascii values 0-65 must be 0
#
# Wallet will be converted to uppercase always!

sub createtable {
  my @l=();
  for (my $c=0; $c<10; $c++) { push @l,ord($c) }
  for (my $c='A'; $c le 'F'; $c++) { push @l,ord($c) }
  foreach my $m (@l) {
    foreach my $n (@l) {
      push @WXOR,{ add => chr($m).chr($n), value => $m ^ $n };
    }
  }
}

sub findwallet {
  if (!-f "$WALLETDIR/wallet$FCCEXT") {
    if (-f "$WALLETDIR/wallet/wallet$FCCEXT") {  $WALLETDIR="$WALLETDIR/wallet" }
    elsif (-d "$WALLETDIR/wallet") {  $WALLETDIR="$WALLETDIR/wallet" }
    elsif (-f "../wallet$FCCEXT") {  $WALLETDIR=".." }
    elsif (-f "../wallet/wallet$FCCEXT") { $WALLETDIR="../wallet" }
    elsif (-d "../wallet") {  $WALLETDIR="../wallet" }
  }
  return (-e "$WALLETDIR/wallet$FCCEXT")
}

sub publichash {
  my ($wallet) = @_;
  if (ref($wallet) eq "FCC::wallet") { $wallet=$wallet->{wallet} }
  if (validwallet($wallet)) {
    return substr($wallet,2,64)
  }
  return ""
}

sub validatehash {
  my ($wid,$pubkey) = @_;
  if (createwalletaddress($pubkey) eq $wid) {
    return 1
  }
  return 0
}

sub createwalletaddress {
  my ($pubkey) = @_;
  my $pubhash=securehash($pubkey);
  my $xor=ord('5') ^ ord('1'); # 4
  if ($COIN eq 'PTTP') {
    $xor=ord('1') ^ ord('1');
  }
  for (my $c=0;$c<64;$c++) {
    $xor ^= ord(substr($pubhash,$c,1)); 
  }
  my $checksum="";
  foreach my $try (@WXOR) {
    if (($try->{value} ^ $xor) == 0) {
      $checksum=$try->{add}; last
    }
  }
  if ($COIN eq 'PTTP') {
    return '11'.$pubhash.$checksum;
  } else {
    return '51'.$pubhash.$checksum;
  }
}

sub newwallet {
  my ($name) = @_;
  if (!$name) { $name = "[ No name ]" }
  my ($pubkey, $privkey) = Crypt::Ed25519::generate_keypair;
  my $pubhex = octhex($pubkey);
  my $wallet = {
    pubkey => $pubhex,
    privkey => octhex($privkey),
    wallet => createwalletaddress($pubhex),
    name => $name
  };
  bless($wallet); return $wallet
}

sub validwallet {
  my ($wallet) = @_;  
  if (!$wallet) { return 0 }
  $wallet=uc($wallet);
  if (length($wallet) != 68) { return 0 }
  my $xor=ord('5') ^ ord('1'); # 4  
  if ($COIN eq 'PTTP') {
    $xor=ord('1') ^ ord('1');
    if (substr($wallet,0,2) ne '11') { return 0 }
  } else {
    if (substr($wallet,0,2) ne '51') { return 0 }
  }
  for (my $c=2;$c<68;$c++) {
    my $h=substr($wallet,$c,1);
    if ((($h ge '0') && ($h le '9')) || (($h ge 'A') && ($h le 'F'))) {
      $xor ^= ord($h)
    } else {
      return 0
    }
  }
  if ($xor != 0) { return 0 }
  return 1
}

sub walletexists {
  return (-e "$WALLETDIR/wallet$FCCEXT")
}

sub walletisencoded {
  if (-e "$WALLETDIR/wallet$FCCEXT") {
    my $winfo=dec_json(gfio::content("$WALLETDIR/wallet$FCCEXT"));
    if (ref($winfo) eq 'HASH') {
      if ($winfo->{encoded}) { return 1 }
    }
  }
  return 0
}

sub loadwallets {
  my ($password) = @_;
  my $wlist=[];
  print "Looking for wallet at $WALLETDIR/wallet$FCCEXT\n";
  if (-e "$WALLETDIR/wallet$FCCEXT") {
    my $winfo=dec_json(gfio::content("$WALLETDIR/wallet$FCCEXT"));
    if (ref($winfo) eq 'HASH') {
      # wallet v2+
      if ($winfo->{encoded}) {
        my ($seed,$hash)=(substr($winfo->{encoded},0,8),substr($winfo->{encoded},8));
        if (securehash($seed.$COIN.$password) ne $hash) { return [ { error => 'invalid password' } ] }
      }
      $wlist=$winfo->{wlist};
      foreach my $wallet (@$wlist) {
        bless($wallet);
        if (!$wallet->{name}) { $wallet->{name}="[ No name ]" }
        if ($winfo->{encoded}) {
          if ($wallet->{pubkey}) { $wallet->{pubkey}=fccencode(hexoct($wallet->{pubkey}),$password) }
          if ($wallet->{privkey}) { $wallet->{privkey}=fccencode(hexoct($wallet->{privkey}),$password) }
          for my $type ('private','public','contact') {
            if (ref($wallet->{$type}{Debit})) {
              for my $c (keys %{$wallet->{$type}{Debit}}) {
                for my $d (@{$wallet->{$type}{Debit}{$c}}) {
                  if ($d->{pubkey}) { $d->{pubkey}=fccencode(hexoct($d->{pubkey}),$password) }
                  if ($d->{privkey}) { $d->{privkey}=fccencode(hexoct($d->{privkey}),$password) }
                }
              }
            }
          }
        }
      }
    } else {
      # wallet v1      
      foreach my $wallet (@$wlist) {
        if (!$wallet->{name}) { $wallet->{name}="[ No name ]" }
      }
      $wlist=$winfo
    }
  }
  return $wlist
}

sub savewallet {
  my ($wallet,$password) = @_;
  if (ref($wallet) ne "FCC::wallet") { error "FCC::wallet::savewallet - Wallet given is not a FCC blessed wallet" }
  my $wlist=loadwallets($password);
  if (($#{$wlist}==0) && ($wlist->[0]{error})) {
    error("FCC::wallet::savewallet - Adding wallet with wrong password")
  }
  push @{$wlist},$wallet;
  savewallets($wlist,$password)
}

sub savewallets {
  my ($wlist,$password) = @_;
  # will overwrite password, be careful
  my $enc="";
  if ($password) {
    my $seed=""; for (my $i=0;$i<8;$i++) { $seed.=hexchar(int rand(16)) }
    $enc=$seed.securehash($seed.$COIN.$password)
  }
  my $wcl=[]; 
  foreach my $w (@$wlist) {
    my $wallet = {};
    if ($w->{name}) { $wallet->{name} = $w->{name} }
    if ($w->{wallet}) { $wallet->{wallet} = $w->{wallet} }
    if ($w->{pubkey}) { $wallet->{pubkey} = $password ? fccencode(hexoct($w->{pubkey}),$password) : $w->{pubkey} }
    if ($w->{privkey}) { $wallet->{privkey} = $password ? fccencode(hexoct($w->{privkey}),$password) : $w->{privkey} }
    # Type
    for my $type ('private','public','contact') {
      if (ref($w->{$type})) {
        $wallet->{$type}=$w->{$type};
        # Type Debit
        if (ref($wallet->{$type}{Debit})) {
          # Type Debit Coin
          for my $c (keys %{$wallet->{$type}{Debit}}) {
            # Type Debit Coin Wallets
            for my $d (@{$wallet->{$type}{Debit}{$c}}) {
              if ($d->{pubkey}) { $d->{pubkey}=$password ? fccencode(hexoct($d->{pubkey}),$password) : $d->{pubkey} }
              if ($d->{privkey}) { $d->{privkey}=$password ? fccencode(hexoct($d->{privkey}),$password) : $d->{privkey} }
            }
          }
        }
      }
    }
    push @$wcl,$wallet
  }
  gfio::create("$WALLETDIR/wallet$FCCEXT",toJSON({ encoded => $enc, version => '2.1', wlist => $wcl }))
}

sub loadwallet {
  my ($wkey,$password) = @_;
  if (defined $wkey) { $wkey=uc($wkey) }
  my $wlist=loadwallets($password);
  if (($#{$wlist}==0) && ($wlist->[0]{error})) { return $wlist->[0] }
  if (validwallet($wkey)) {
    foreach my $wallet (@$wlist) {
      if ($wallet->{wallet} eq $wkey) { return $wallet }
    }
  } elsif (!$wkey && ($#{$wlist}>=0)) {
    my $wallet=$wlist->[0]; return $wallet
  }
  return undef
}

sub validwalletpassword {
  my ($password) = @_;
  if (-e "$WALLETDIR/wallet$FCCEXT") {
    my $winfo=dec_json(gfio::content("$WALLETDIR/wallet$FCCEXT"));
    if (ref($winfo) eq 'HASH') {
      if ($winfo->{encoded}) {
        my $seed=substr($winfo->{encoded},0,8);
        my $hash=substr($winfo->{encoded},8);
        my $phash=securehash($seed.$COIN.$password);
        return ($phash eq $hash)
      }
    }
  }
  return 1
}

# EOF FCC::wallet (C) 2018 Domero
```

---

- `FCC/miner.pm`:
```perl
#!/usr/bin/perl

package FCC::miner;

#############################################################
#                                                           #
#     FCC Miner functions                                   #
#                                                           #
#    (C) 2019 Chaosje Domero                                #
#    Leaves are less strict, the node will check all        #
#                                                           #
#############################################################

use strict;
no strict 'refs';
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '1.1.3';
@ISA         = qw(Exporter);
@EXPORT      = qw(fac initperm perm minehash solhash);
@EXPORT_OK   = qw();

use FCC::global 2.3.1;

1;

sub fac {
  my ($f) = @_;
  my $fac=1; while ($f>1) { $fac*=$f; $f-- } return $fac
}

sub initperm {
  my ($len) = @_;
  my $p=""; for my $i (0..$len-1) { $p.=chr(65+$i) } return $p
}

sub perm {
  my ($init,$k) = @_;
  my $n=length($init); my $dn=$n;
  my $out=""; my $m=$k;
  for (my $i=0;$i<$n;$i++) {
    my $ind=$m % $dn;  
    $out.=substr($init,$ind,1);
    $m=$m / $dn;  
    $dn--;
    substr($init,$ind,1,substr($init,$dn,1));
  }
  return $out
}

sub minehash {
  my ($coincount,$suggest) = @_;
  return securehash($COIN.dechex($coincount,8).$suggest);
}

sub solhash {
  my ($wallet,$solution) = @_;
  return securehash($wallet.$solution)
}
```

---

- `FCC/global.pm`:
```perl
#!/usr/bin/perl

package FCC::global;

#######################################
#                                     #
#     FCC Global functions            #
#                                     #
#    (C) 2019 Domero                  #
#                                     #
#######################################

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '2.3.2';
@ISA         = qw(Exporter);
@EXPORT      = qw($COIN $HP setcoin $FCCVERSION $FCCBUILD $FCCEXT $FCCTIME $FCCMAGIC $FCCSERVERKEY $TRANSTYPES $RTRANSTYPES
                  $MINIMUMFEE $MINERPAYOUT $MINEBONUS $FCCSERVERIP $FCCSERVERHOST $FCCSERVERPORT ledgerversion
                  prtm securehash octhex hexoct hexchar dechex hexdec validh64 encode_base64 decode_base64 rsp
                  fcctime setfcctime fcctimestring extdec doggy calcfee doggyfee fccstring fccencode zb64 b64z zip unzip);
@EXPORT_OK   = qw();

use POSIX;
use Digest::SHA qw(sha256_hex sha512_hex);
use gfio 1.11;
use Crypt::Ed25519;
use Compress::Zlib;
use gerr 1.02 qw(error);

our $COIN = "FCC";
our $FCCVERSION = "0101"; # ledger version
our $FCCBUILD = $VERSION;   # software version
our $FCCTIME = tzoffset();
our $FCCMAGIC = 'FF2F89B12F9A29CAB2E2567A7E1B8A27C8FA9BF7A1ABE76FABA7919FC6B6FF0F';
our $FCCSERVERIP = '149.210.194.88'; # factorialcoin.nl
our $FCCSERVERHOST = 'factorialcoin.nl'; # 
our $FCCSERVERPORT = 5151;
our $FCCSERVERKEY = "FCC55202FF7F3AAC9A85E22E6990C5ABA8EFBB73052F6EA1867AF7B96AE23FCC";
our $FCCEXT = '.fcc';
our $MINIMUMFEE = 50;
our $MINERPAYOUT = 1000000000;
our $MINEBONUS = 50000000;
our $TRANSTYPES = {
  genesis => '0',
  in => '1',
  out => '2',
  coinbase => '3',
  fee => '4'
};
our $RTRANSTYPES = {};
foreach my $k (keys %$TRANSTYPES) {
  $RTRANSTYPES->{$TRANSTYPES->{$k}}=$k
}
our $HP = {}; for (my $i=0;$i<10;$i++) { $HP->{$i}=$i }
$HP->{'A'}=10; $HP->{'B'}=11; $HP->{'C'}=12; $HP->{'D'}=13; $HP->{'E'}=14; $HP->{'F'}=15; 
1;

sub setcoin {
  $COIN=uc($_[0]);
  if ($COIN eq 'PTTP') {
    $FCCMAGIC = "8BF879BEC8FA9EC6CA3E7A96B26F7AA76F6AA4E78BADCFA1665A8A9CD67ADD0F";
    $FCCSERVERPORT = 9612;
    $FCCSERVERKEY = "1111145AFA4FBB1CF8D406A234C4CC361D797D9F8F561913D479DBC28C7A4F3E";
    $FCCEXT = '.pttp';
    $FCCBUILD = '1.4.2';
    $MINIMUMFEE = 110;
  } elsif ($COIN eq 'FCC') {
    $FCCMAGIC = "FF2F89B12F9A29CAB2E2567A7E1B8A27C8FA9BF7A1ABE76FABA7919FC6B6FF0F";
    $FCCSERVERPORT = 5151;
    $FCCSERVERKEY = "FCC55202FF7F3AAC9A85E22E6990C5ABA8EFBB73052F6EA1867AF7B96AE23FCC";
    $FCCEXT = '.fcc';
    $FCCBUILD = $VERSION;
    $MINIMUMFEE = 50;
  } elsif ($COIN ne 'FCC') {
    die "Unknown coin '$_[0]'"
  }
}

sub tzoffset {
  my $t = time();
  my $utc = mktime(gmtime($t));
  my $local = mktime(localtime($t));
  return ($utc - $local);
}

sub fcctime {
  if (!$_[0]) { $FCCTIME=0; return }
  my $t = time();
  my $local = mktime(localtime($t));
  $FCCTIME = $_[0] - $local
}

sub ledgerversion {
  my $major = int substr($FCCVERSION,0,2);
  my $minor = int substr($FCCVERSION,2,2);
  return join('.',$major,$minor)
}

sub setfcctime {
  $FCCTIME=$_[0]
}

sub fcctimestring {
  my ($time) =@_;
  if (!$time) { $time=time + $FCCTIME }
  my @t=localtime($time);
  my $tm=('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$t[6]]; $tm.=", ";
  my $yr=$t[5]+1900; my $mon=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$t[4]];
  $tm.="$t[3] $mon $yr ";
  $tm.=join(':',sprintf("%02d",$t[2]),sprintf("%02d",$t[1]),sprintf("%02d",$t[0]));
  $tm.=" GMT";
  return $tm
}

sub securehash {
  my ($code) = @_;
  if (!$code) { error "FCC.Global.SecureHash: No Code given to hash!" }
  return uc(sha256_hex(sha512_hex($code)))
}

sub octhex {
  my ($key) = @_;
  if (!defined $key) { return "" }
  my $hex;
  for (my $i=0;$i<length($key);$i++) {
    my $c=ord(substr($key,$i,1));
    $hex.=sprintf('%02X',$c);
  }
  return $hex  
}

sub hexoct {
  my ($hex) = @_;
  if (!defined $hex) { return "" }
  my $key="";
  for (my $i=0;$i<length($hex);$i+=2) {
    my $h=substr($hex,$i,2);
    $key.=chr(hex($h));
  }
  return $key
}

sub hexchar {
  my ($num) = @_;
  return (0,1,2,3,4,5,6,7,8,9,'A','B','C','D','E','F')[$num]
}

sub dechex {
  my ($dec,$len) = @_;
  if (!defined $dec) { error ("FCC::global::dechex: No decimal given") }
  if (!$len) { error "FCC::global::dechex - No length given" }
  my $out="";
  if ($len==1) { return hexchar($dec & 15) }
  while ($len>0) {
    my $byte=$dec & 255;
    my $hex=hexchar($byte >> 4);
    $hex.=hexchar($byte & 15);
    $out="$hex$out";
    $dec>>=8;
    $len-=2
  }
  return $out
}

sub hexdec {
  my ($hex) = @_;
  if ($hex =~ /[^0-9A-F]/) {
    error "FCC::global::hexdec - Illegal hex given '$hex'"
  }
  my $dec=0;
  for (my $i=0;$i<length($hex);$i++) {
    $dec<<=4; $dec+=hex(substr($hex,$i,1))
  }
  return $dec
}

sub validh64 {
  my ($hex) = @_;
  if (length($hex) != 64) { return 0 }
  if ($hex =~ /[^0-9A-F]/) { return 0 }
  return 1
}

sub extdec {
  my ($dec) = @_;
  $dec=$dec || 0; my $d=int($dec);
  my $v=int(($dec + 0.000000005 - $d)*100000000);
  while (length($v)<8) { $v="0$v" }
  return $d.'.'.$v
}

sub doggy {
  my ($amount) = @_;
  return int(($amount+0.000000005)*100000000)
}

sub feeint {
  my ($fee) = @_;
  return int($fee*100)
}

sub calcfee {
  my ($amount,$fee) = @_;
  if (!$fee) { return 0 }
  $amount=extdec($amount);
  my $feefloat=(feeint($fee)/100);
  my $cfee=extdec($amount*($feefloat/100));
  if ($cfee eq '0.00000000') { $cfee='0.00000001' }
  return $cfee
}

sub doggyfee {
  my ($amount,$fee) = @_;
  if (!$fee) { return 0 }
  my $cfee=int($amount*($fee/10000));
  if (!$cfee) { $cfee=1 }
  return $cfee
}

sub fccstring {
  my ($amount,$fee) = @_;
  return extdec(extdec($amount)+calcfee($amount,$fee))
}

sub fccencode {
  my ($data,$password) = @_;
  my $h1=securehash($password);
  my $h2=securehash(scalar reverse $password);
  my $pos=0; my $offset=0; my $todo=length($data); my $dpos=0; my $coded="";
  while ($dpos<$todo) {
    my $get=$HP->{substr($h2,$pos,1)};
    $pos+=$get; $pos %= 64; if ($pos == 63) { $pos=0 }
    my $code=($HP->{substr($h1,$pos,1)}<<4) + $HP->{substr($h1,$pos+1,1)};
    my $tocode=ord(substr($data,$dpos,1));
    $coded.=chr($code ^ $tocode);
    $dpos++
  }
  return octhex($coded)
}

sub encode_base64_char {
  my ($code,$c62,$c63) = @_;
  if (!$c62) { $c62='+' }
  if (!$c63) { $c63='/' }
  if ($code<26) { return chr(ord('A') + $code) }
  if ($code<52) { return chr(ord('a') + $code-26) }
  if ($code<62) { return chr(ord('0') + $code-52) }
  if ($code==62) { return $c62 }
  if ($code==63) { return $c63 }
}

sub encode_base64 {
  # RFC 3548
  my ($data) = @_;
  my $c62='+'; my $c63="/"; my $pad="="; 
  my $len=length($data);
  my $pos=0; my $val=0; my $br=0; my $out=""; my $written=0;
  while ($pos<$len) {
    my $code=ord(substr($data,$pos,1)); $val<<=8; $val+=$code; $br+=8;
    while ($br>=6) {
      my $c=($val>>($br-6)); $br-=6; $val&=((1<<$br)-1);
      $out.=encode_base64_char($c,$c62,$c63); $written++
    }
    $pos++;
  }
  if ($br) {
    $val<<=(6-$br); $out.=encode_base64_char($val,$c62,$c63); $written++;
  }  
  # padding
  while ($written % 4 > 0) {
    $out.=$pad; $written++; 
  }
  return $out
}

sub decode_base64 {
 # RFC 3548
 my ($data) = @_;
 my $c62='+'; my $c63="/"; my $pad="="; 
 my $len=length($data);
 my $pos=0; my $val=0; my $br=0; my $end=0; my $out="";
 while ($pos<$len && !$end) {
   my $enc=substr($data,$pos,1);
   if ($enc =~ /([A-Z])/) { $val=($val<<6)+ord($1)-ord('A'); $br+=6 }
   elsif ($enc =~ /([a-z])/) { $val=($val<<6)+26+ord($1)-ord('a'); $br+=6 }
   elsif ($enc =~ /([0-9])/) { $val=($val<<6)+52+ord($1)-ord('0'); $br+=6 }
   elsif ($enc eq $c62) { $val=($val<<6)+62; $br+=6 }
   elsif ($enc eq $c63) { $val=($val<<6)+63; $br+=6 }
   elsif ($enc eq $pad) { $val=($val<<6); $br+=6; $end++ }
   if (!$val && $end) { return $out }
   while ($br>=8) {
     my $c=($val>>($br-8)); $out.=chr($c); $br-=8; $val&=((1<<$br)-1)
   }
   $pos++;
 }
 if ($br) {
   my $c=($val>>(8-$br)); $out.=chr($c)
 }
 return $out
}

sub unzip {
  my ($data) = @_;
  return Compress::Zlib::memGunzip($data);
}

sub zip {
  my ($data) = @_;
  return Compress::Zlib::memGzip($data);
}

sub zb64 {
  my ($data) = @_;
  return encode_base64(zip($data))
}

sub b64z {
  my ($data) = @_;
  return unzip(decode_base64($data))
}

sub prtm {
  my ($s,$m,$h) = localtime(time + $FCCTIME);
  if (length($s)<2) { $s="0$s" }
  if (length($m)<2) { $m="0$m" }
  if (length($h)<2) { $h="0$h" }
  print STDOUT "[$h:$m:$s] ";
  return ""
}

sub rsp {
  my ($str,$sp) = @_;
  my $x=($sp-length($str));
  my $out=' 'x$x; return $out.$str
}

# EOF FCC::global (C) 2019 Domero
```

---

- `gserv.pm`:
```perl
#!/usr/bin/perl
# -w -CSDA

package gserv;

######################################################################
#                                                                    #
#          Round Robin Server                                        #
#           - websockets, telnet, http, raw, IceCast                 #
#           - *Multi-Domain* SSL support                             #
#           - fully bidirectional non-blocking, all systems          #
#                                                                    #
#          (C) 2018 Domero                                           #
#          ALL RIGHTS RESERVED                                       #
#                                                                    #
#      Events:                                                       #
#                                                                    #
#      connect: an uninitialized client has connected on TCP/IP      #
#      handshake: a client has performed an initializing handshake   #
#      input: a client received a message from the server            #
#      quit: a client has quit the connection                        #
#      error: a client has encountered an error                      #
#      telnet: a client is running under telnet                      #
#      http: a client is running under HTTP                          #
#      websockets: a client is running under WebSockets              #
#      sent: a block data has finished sending to the server         #
#                                                                    #
#      Errors:                                                       #
#                                                                    #
#         1 Server has been terminated                               #
#         2 Ping Timeout                                             #
#       106 Client aborted connection                                #
#       108 Client forcebly closed connection                        #
#       110 Connection timed out                                     #
#       113 No route to host                                         #
#       130 Killed by interrupt                                      #
#       400 Bad request                                              #
#       405 Method not allowed                                       #
#       408 Request timeout                                          #
#       426 Upgrade required                                         #
#      1000 Process killed by administrator                          #
#      1002 Protocol error                                           #
#      1009 Insufficient storage                                     #
#                                                                    #
######################################################################

use strict;
use warnings;
no warnings 'uninitialized';
no warnings 'utf8';
use Socket;
use IO::Socket::IP -register;
use IO::Handle;
use IO::Select;
use IO::Socket::SSL;
use POSIX qw(:sys_wait_h :errno_h EAGAIN EBUSY mktime);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Time::HiRes qw(usleep gettimeofday);
use Digest::SHA qw(sha256 sha256_hex sha512);
use Digest::SHA1 qw(sha1);
use Digest::MD5 qw(md5);
use HTTP::Date;
use Crypt::Ed25519;
use utf8;
use gerr qw(error);
use gpost 1.2.1;
use HTML::Entities;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '5.5.2';
@ISA         = qw(Exporter);
@EXPORT      = qw(wsmessage);
@EXPORT_OK   = qw(prtm localip init start wsmessage out burst takeloop broadcast wsbroadcast broadcastfunc httpresponse cpu32);

my $CID = 0;
my $SSLPATH='/etc/letsencrypt/live';
my $SSLCERT='cert.pem';
my $SSLKEY='privkey.pem';
my $SSLCA='chain.pem';

my $cpu32 = (~0 == 4294967295);

################################################################################
binmode(STDOUT);
binmode(STDERR);

sub log {
  my($serv,@msg)=@_;
  if (ref($::LOG) eq 'CODE') { $::LOG->(@msg) }
  elsif (ref($::API_LOG) eq 'CODE') { $::API_LOG->(@msg) }
  else{ print STDOUT prtm(),@_,"\n" }
}
################################################################################

sub setssl {
  my ($path,$cert,$key,$ca) = @_;
  if ($path) { $SSLPATH=$path }
  if ($cert) { $SSLCERT=$cert }
  if ($key) { $SSLKEY=$key }
  if ($ca) { $SSLCA=$ca }
}

sub init {
  my ($clienthandle,$clientloop,$ssldomain,$serverhandle) = @_;
  if (ref($clienthandle) ne 'CODE') {
    error "Eureka server could not initialize: No clienthandle given."
  }
  if ((defined $clientloop) && (ref($clientloop) ne 'CODE')) {
    error "Eureka server could not initialize: Invalid clientloop-handle given."
  }
  my $self = {
    isserver => 1,
    name => "Eureka Server $VERSION by Chaosje (C) 2019 Domero",      # Server name
    version => $VERSION,                     # server version
    ssl => defined $ssldomain && $ssldomain, # Use SSL
    sske => 0,                               # Use SSKE
    ssldomain => $ssldomain,                 # SSL keys will be found in $SSLPATH/ssldomain
    ssldebug => 1,                           # debug SSL process information
    verbose => 1,                            # Output to STDOUT
    debug => 0,                              # verbose everything
    websocketmode => 0,                      # Only allow websocket connections
    linemode => 0,                           # Split lines even in raw mode
    killhttp => 0,                           # kill http-clients automatically when done with output
    maxdatasize => 52428800,                 # 50MB, Maximum data-size which may be received in one package (websockets) (must be more than 65534)
    pingtime => 30,                          # seconds on ilde to check we're still alive
    pingtimeout => 5,                        # seconds for clients to respond on ping with pong before ping-timeout
    verbosepingpong => 0,                    # Verbose ping/pong requests and responses
    verboseheader => 0,                      # Verbose the HTTP-header
    timeout => 10,                           # Seconds to idle to server before timeout (0=unlimited)
    buffersize => 1024*64,                   # Bytes to read from socket at loop-passes
    server => {
      host => localip(),                     # Our IP-addres
      loopwait => 1000,                      # Main wait-time if idle in nanoseconds (1000000/number of user to expect)
      port => 12345,                         # port to connect to
      clienttimeout => 20,                   # time the server will respond to clients, 0 = no timeout
      starttime => 0,                        # time in usec when server was started.
      running => 0,                          # Is the server running?
    },
    userlist => {},                          # allowed logins
    clients => [],                           # connected clients for round robin
    current => 0,                            # current executing process
    numclients => 0,                         # number of connected clients
    maxclients => 1000,                      # maximum connections allowed (0 = unlimited)
    allowedip => [
      '10.*',      
      '192.168.*',      
      '127.0.0.1',
    ],                                       # allowed IP's, leave empty ([]) for all.
    blockedip => [],                         # the firewall
    idletimeout => 0,                        # kills a client on X seconds of inactivity (0 = no timeout)
    clienthandle => $clienthandle,           # handle called whenever there is a client-method
    clientloop => $clientloop,               # handle called on every processing loop
    serverhandle => $serverhandle,           # handle called on every processing loop
    activeclient => undef,                   # set when a process is in active handling to signal from outside
  };
  bless($self);
  return $self
}

sub start {
    my ($self, $autoloop, $servloop) = @_;
    if ($servloop && (ref($servloop) ne 'CODE')) { error "GServ.Start: ServLoop is not a coderef" }
    $self->{servloop} = $servloop;
    my $err = "";
    if ($self->{debug}) { $self->{verbosepingpong} = 1 }
    if ($self->{maxdatasize} < 65535) { $self->{maxdatasize} = 65535 } # (websockets) allow a minimum of 64Kb data packets.

    # Auto flush and select Console
    select(STDOUT); $| = 1;

    # Setup TCP/IP & SSL
    my $proto = getprotobyname('tcp');
    if ($self->{ssl}) {
        if (ref($self->{ssldomain}) ne 'ARRAY') {
            $self->{ssldomain} = [$self->{ssldomain}];
        }
        $self->{sslcert} = {};
        $self->{sslkey} = {};
        $self->{sslca} = {};
        for my $ssldomain (@{$self->{ssldomain}}) {
            $self->{sslcert}{$ssldomain} = "$SSLPATH/$ssldomain/$SSLCERT";
            if (!-e $self->{sslcert}{$ssldomain}) {
                $self->log("SSL-certificate '$self->{sslcert}{$ssldomain}' does not exist");
                return $self;
            }
            $self->{sslkey}{$ssldomain} = "$SSLPATH/$ssldomain/$SSLKEY";
            if (!-e $self->{sslkey}{$ssldomain}) {
                $self->log("SSL-key '$self->{sslkey}{$ssldomain}' does not exist");
                return $self;
            }
            $self->{sslca} = "$SSLPATH/$ssldomain/$SSLCA";
            if (!-e $self->{sslca}) {
                $self->log("SSL-ca '$self->{sslca}' does not exist");
                return $self;
            }
        }
    }

    # create a socket, make it reusable, set buffers
    socket($self->{server}{socket}, PF_INET, SOCK_STREAM, $proto) or $err = "Can't open socket: $!";
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }
    setsockopt($self->{server}{socket}, SOL_SOCKET, SO_REUSEADDR, 1) or $err = "Can't set socket: $!";
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }
    setsockopt($self->{server}{socket}, SOL_SOCKET, SO_RCVBUF, 1<<20) or $err = "Can't set socket's receive buffer: $!";
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }
    setsockopt($self->{server}{socket}, SOL_SOCKET, SO_SNDBUF, 2<<20) or $err = "Can't set socket's send buffer: $!"; # 2 MB
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }

    # grab a port on this machine
    my $paddr = sockaddr_in($self->{server}{port}, INADDR_ANY);

    # bind to a port, then listen
    bind($self->{server}{socket}, $paddr) or $err = "Can't bind to address $paddr: $!";
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }
    listen($self->{server}{socket}, SOMAXCONN) or $err = "Server can't listen: $!";
    if ($err) {
        if ($self->{ssl} && $self->{ssldebug}) { $self->log("SOCKET_SSL_ERROR: $err") }
        $self->{error} = $err;
        return $self;
    }

    # set autoflush on
    $self->{server}{socket}->autoflush(1);

    # set server accept to non-blocking, otherwise the server will block waiting
    IO::Handle::blocking($self->{server}{socket}, 0);
    if ($^O =~ /win/i) {
        my $nonblocking = 1;
        ioctl($self->{server}{socket}, 0x8004667e, \$nonblocking);
    }

    $self->{server}{running} = 1;
    $self->{start} = gettimeofday();
    if ($self->{verbose}) { $self->log("Server '$self->{name}' started on port $self->{server}{port}") }
    if (ref($self->{serverhandle}) eq 'CODE') { &{$self->{serverhandle}}('connected') }

    # Internal Loopmode
    $self->{loopmode} = $autoloop;
    if ($autoloop) {
        while ($self->{server}{running}) {
            $self->takeloop;
        }
    }

    return $self;
}

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

sub takeloop {
  my ($self) = @_;
  if (!$self->{server}{running}) { return }
  my $client;
  my $func=$self->{serverhandle};
  if (($self->{numclients}<$self->{maxclients}) || ($self->{maxclients} == 0)) {
    my $client_addr = accept($client, $self->{server}{socket});
    if ($client_addr) {
      
      # :) Let's help the patient
      
      # make sure binmode
      binmode($client);

      # Autoflush must be on
      $client->autoflush(1);

      # Non-blocking for UNIX. Won't harm other systems
      $client->blocking(0);

      # Client IP:PORT
      my ($port,$iph) = sockaddr_in($client_addr); 
      my $ip = inet_ntoa($iph);
      
      # Non-blocking
      my $socketerr=0;
      if ($^O =~ /win/i) {
        # Non-blocking for Windows. _IOW('f', 126, u_long)
        my $nonblocking = 1; ioctl($client, 0x8004667e, \$nonblocking);
      } else {
        # And just to make sure it is non-blocking a third method (nobody knows all systems)
        my $flags = fcntl($client, F_GETFL, 0) or $socketerr=1;
        $flags = fcntl($client, F_SETFL, $flags | O_NONBLOCK) or $socketerr=1;
        if ($socketerr) {
          &$func($client,'error',"[$ip\:$port] Cannot set non-blocking mode on socket!");
          if ($self->{verbose}) {
            $self->log("ERROR [$ip\:$port] Cannot set non-blocking mode on socket!\n");
          }
          close($client)
        }
      }    

      # find out who connected 
      my $valid=0;
      foreach my $aip (@{$self->{allowedip}}) {
        if ($aip eq '*') { $valid=1; last }
        if ($ip =~ /$aip/) { $valid=1 }
      }
      foreach my $bip (@{$self->{blockedip}}) {
        if ($ip =~ /$bip/) { $valid=0 }
      }
      if (!$valid) {
        &$func($client,'error',"[$ip\:$port] ILLEGAL ACCESS");
        if ($self->{verbose}) {
          $self->log("[$ip\:$port] ILLEGAL ACCESS\n");
        }  
        close($client)        
      } elsif (!$socketerr) {  
        my $tm=gettimeofday();
        my $host='localhost';
        if ($ip ne '127.0.0.1') {
          $host=gethostbyaddr($iph, AF_INET);
          if (!$host) {
            if (($ip =~ /^192\.168/) || ($ip =~ /^10\.0\.0/)) { $host='LAN' }
            else { $host='UnknownHost' }
          }
        }

        # SSL
        my $sslerr=0;
        my $sslforward=0;
        if ($self->{ssl}) {
          IO::Socket::SSL->start_SSL($client,
            SSL_server => 1,
            SSL_verify_mode => SSL_VERIFY_FAIL_IF_NO_PEER_CERT,#SSL_VERIFY_NONE
            SSL_cert_file => $self->{sslcert},
            SSL_key_file => $self->{sslkey},
            SSL_ca_file => $self->{sslca},
            Listen => 128
          ) or $sslerr=1;
          if ($sslerr) {
            &$func($client,'error',$SSL_ERROR);
            if (
              $SSL_ERROR =~ /\:1408F09C\:/gs #||   # SSL routines:ssl3_get_record:http request
            #  $SSL_ERROR =~ /\:14094416\:/gs      # SSL routines:ssl3_read_bytes:sslv3 alert certificate unknown
            #  $SSL_ERROR =~ /\:1422E0EA\:/gs      # SSL routines:final_server_name:callback failedlo:version too low
            ) {
              $sslforward=1;
              &$func($client,'ssl_forward',{ip=>$ip,port=>$port,host=>$host,error=>"http request"});
              if ($self->{verbose}) {
                $self->log("[Forwarding][$ip]");
              }
            }else{
              &$func($client,'ssl_error',{ip=>$ip,port=>$port,host=>$host,error=>$SSL_ERROR});
              if ($self->{verbose}) {
                $self->log("[$ip:$port] $SSL_ERROR");
              }
              close($client) 
            }
          }
        }

        if (!$sslerr||$sslforward) {
          $CID++;
          my $cl=gserv::client->new($self,{
            id => $CID,
            socket => $client,
            ssl => $sslforward ? undef : $self->{ssl},
            sslforward => $sslforward,
            handle => $client_addr,
            host => $host,
            ip => $ip,
            iphandle => $iph,
            port => $port,
            serverport => $self->{server}{port},
            server => $self,
            start => $tm,
            last => $tm,
            quit => 0,
            keepalive => 1,
            pingtime => $self->{pingtime},
            pingtimeout => $self->{pingtimeout},
            lastping => $tm,
            pingsent => 0,
            pings => {},
            telnet => 0,
            httpmode => 0,
            httpreadheader => 0,
            httpheader => {},
            sskemode => 0,
            sskeactive => 0,
            websockets => 0,
            icecast => 0,
            iceversion => "",
            mountpoint => "",
            killme => 0,
            killafteroutput => 0,
            init => 1,
            verbosepingpong => $self->{verbosepingpong},
            outputmode => 0,
            outputbuffer => "",
            outputpointer => 0,
            outputlength => 0,
            httpreadpost => 0,
            postdata => '',
            post => {},
            selector => IO::Select->new($client),
            bytessent => 0,
            bytesreceived => 0,
            bustmode => 0,
            wsbuffer => "",
            wsdata => "",
            wstype => "",
          });
          #if ($self->{sske}) {
          #  $cdata->{sske} = { transkey => createkey(), transfunc => createkey() };
          #  $cdata->{sskemode}=1
          #}
          #push @{$self->{clients}},$cdata;
          #$self->{numclients}++;
          #if ($self->{verbose}) { $self->log("JOIN $ip\:$port ($host)") }
          #if ($self->{serverhandle}) { my $func=$self->{serverhandle}; &$func('connect',$cdata) }
          #my $func=$self->{clienthandle};
          #&$func($cdata,'connect')
        }
      }
    }
  }
  if ($self->{numclients}) {
    # We probably got work to do!
    my $start=gettimeofday();
    $self->{deleteflag}=0;
    $self->handleclient();
    $self->{activeclient}=undef;
    if (!$self->{deleteflag}) { $self->{current}++; }
    if ($self->{current}>=$self->{numclients}) {
      $self->{current}=0
    }
    my $end=gettimeofday();
    if (($end<$start) || ($end-$start<$self->{server}{loopwait})) {
      my $dtm=$self->{server}{loopwait}-($end-$start);
      usleep($dtm)
    }
  } else {
    # Get some sleep
    usleep($self->{server}{loopwait})
  }
  if ($self->{servloop}) {
    my $caller=$self->{servloop};
    &$caller($self)
  }
}

sub gtmtimestring {
  my @t=localtime(mktime(localtime(time())));
  my $tm=('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$t[6]]; $tm.=", ";
  my $yr=$t[5]+1900; my $mon=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$t[4]];
  $tm.="$t[3] $mon $yr ";
  $tm.=join(':',sprintf("%02d",$t[2]),sprintf("%02d",$t[1]),sprintf("%02d",$t[0]));
  $tm.=" GMT";
  return $tm
}

sub httpforward_tohttps {
  my ($self,$client) = @_;
  my $loc="";
  if (ref($self) && ref($client)) {
    $loc="[SERV{$self}:CLIENT{$client}]";
    if (defined $client->{httpheader}) {
      my $uri=(defined $client->{httpheader}{uri} ? $client->{httpheader}{uri} : '/');
      my @out=(gserv::httpresponse(301));
      $loc="https://$client->{httpheader}{host}".($self->{server}{port} != 80 && $self->{server}{port} != 443 ? ":$self->{server}{port}":"").$uri;
      if ($client->{httpheader}{getdata}) { $loc.='?'.$client->{httpheader}{getdata} }
      my $html=<<EOT;
  <DOCTYPE html>
  <html><body><div style="left: 0; right: 0; top: 0; bottom: 0; border: 1px black; padding: 40px; margin: auto; color: black; ba
  ckground: red;">Site has been permanently moved<br />$loc</div></body></html>
EOT
      push @out,"Date: ".gtmtimestring();
      push @out,"Server: $self->{name}";
      push @out,"Location: $loc";
      push @out,"Content-Length: ".length($html);
      push @out,"Keep-Alive: timeout=5, max=100";
      push @out,"Connection: Keep-Alive";
      push @out,"Content-Type: text/html; charset=iso-8859-1";
      my $data=join("\r\n",@out)."\r\n\r\n".$html;
      $client->{killafteroutput}=1;
      gserv::burst($client,\$data);
      $self->log("[$client->{ip}:$client->{port}][HTTP_FORWARD > $loc]");
      #$self->log("$data\n");
    }else{
      $loc="no-http-header"
    }
  }else{
    $loc="undefined"
  }
  return $loc
}

sub loopall {
  my ($self) = @_;
  for (my $i=1;$i<=$self->{numclients};$i++) {
    $self->takeloop()
  }
}

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

sub removeclient {
  my ($self) = @_;
  if ($self->{numclients}) {
    $self->{clients}[$self->{current}]=undef;
    splice(@{$self->{clients}},$self->{current},1);
    $self->{numclients}--;    
  }
}

sub deleteclient {
  my ($self,$client,$msg) = @_;
  my $ip='closed'; my $port='closed';
  if ($client) {
    $ip=$client->{ip}; $port=$client->{port};
    if (!$client->{closed}) { 
      $client->{closed}=1;
      if ($client->{selector}) {
        $client->{selector}->remove($client->{socket});
      }
      # Signal WebSocket server to delete client and round things up.
      if ($client->{socket}) {
        if ($client->{ssl}) {
          $client->{socket}->close(SSL_no_shutdown => 1)
        } else {
          shutdown($client->{socket},2); close($client->{socket}); 
        }
      }
    }
  }
  if ($self->{verbose}) {
    # my $err=gerr::trace(); print "$err\n";
    $self->log("QUIT $ip\:$port");
  }
  if ($self->{serverhandle}) {
    my $func=$self->{serverhandle};
    &$func($client,'disconnect')
  }
  my $func=$self->{clienthandle};
  &$func($client,'quit',$msg);
  $self->removeclient();
  $self->{deleteflag}=1;
}

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

sub wschardecode {
  my ($client,$key)=@_;
  my $pos=$client->{wsbufferread} & 3;
  return chr($key ^ $client->{wsmask}[$pos]);
}

sub wsinput {
  # WebSockets hybi06 - v13 - Not the easiest protocol ever..
  # RFC 6455
  my ($self,$client,$data) = @_;
  my $func=$self->{clienthandle};
  if (defined $data) { $client->{wsbuffer}.=$data }
  my $blen=length($client->{wsbuffer});
  if ($blen < 2) { return }
  #print " << INPUT [$len] $self->{host}:$self->{port}     \n";
  my $firstchar=ord(substr($client->{wsbuffer},0,1));
  my $secondchar=ord(substr($client->{wsbuffer},1,1));
  my $type=$firstchar & 15;
  my $final=$firstchar & 128;
  my $continue=0;
  my $blocktype;
  if ($type == 0) { $continue=1 }
  elsif ($type == 1) { $blocktype='text' }
  elsif ($type == 2) { $blocktype='binary' }
  elsif ($type == 8) { $blocktype='close' }
  elsif ($type == 9) { $blocktype='ping' }
  elsif ($type == 10) { $blocktype='pong' }
  else {
    &$func($client,'error',"Invalid WS frame type: $type"); return
  }
  if (!$continue) { $client->{wstype}=$blocktype }
  my $mask=$secondchar & 128;
  if (!$mask) {
    # RFC 6455 - Data MUST be masked!
    &$func($client,'error',"Non-Masked data found in input from client"); return
  }
  my $len=$secondchar & 127; my $offset=2;
  if ($len==126) {
    if ($blen < 4) { return }
    $len=ord(substr($client->{wsbuffer},2,1));
    $len=($len<<8)+ord(substr($client->{wsbuffer},3,1));
    $offset=4
  } elsif ($len==127) {
    if ($blen < 10) { return }
    $len=0;
    for (my $p=0;$p<8;$p++) {
      $len=($len<<8)+ord(substr($client->{wsbuffer},$offset,1));
      $offset++
    }
  }
  if ($blen<$offset+4+$len) { return }
  # YES! We got a package!
  my @mask=();
  for (my $m=0;$m<4;$m++) {
    push @mask,ord(substr($client->{wsbuffer},$offset,1)); $offset++
  }
  my $fdata=""; my $mp=0;
  for (my $i=0;$i<$len;$i++) {
    $fdata.=chr(ord(substr($client->{wsbuffer},$offset,1)) ^ $mask[$mp]); 
    $offset++; $mp=($mp+1) & 3
  }
  $client->{wsdata}.=$fdata;
  if ($final) {
    $self->handlews($client);
    $client->{wsdata}=""
  }
  $client->{wsbuffer}=substr($client->{wsbuffer},$offset);
  # moved to the main loop to prevent: Deep recursion on subroutine "gserv::wsinput";
  if (length($client->{wsbuffer})) { $self->wsinput($client) }
}

sub handlews {
  my ($self,$client) = @_;
  my $func=$self->{clienthandle};
  if (length($client->{wsdata}) > $self->{maxdatasize}) { &func($client,'error',"1009 Datasize too large") }
  if ($client->{wstype} eq 'ping') {
    if ($client->{verbosepingpong}) {
      $self->log("*< PING $client->{ip}\:$client->{port}");
    }
    if ($client->{sskeactive}) { $client->{wsdata}=sskecrypt($client,$client->{wsdata},0) }
    wsmessage($client,$client->{wsdata},'pong');
    $client->{lastping}=gettimeofday();
    $client->{pingsent}=0
  } elsif ($client->{wstype} eq 'pong') {
    if ($client->{verbosepingpong}) {
      $self->log("*< PONG $client->{ip}\:$client->{port}");
    }
    if ($client->{pings}{$client->{wsdata}}) {
      delete $client->{pings}{$client->{wsdata}};
    }
    $client->{lastping}=gettimeofday();
    $client->{pingsent}=0
  } elsif ($client->{wstype} eq 'close') {
    $self->deleteclient($client,$client->{wsdata})
  } else {
    &$func($client,"input",$client->{wsdata})
  }
}

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

sub wsmessage {
  my ($client,$msg,$command) = @_;
  if ($client->{isserver}) { error "Version 3 Design change! wsmessage($client,$msg,$command)" }
  if (!defined($msg) && !defined($command)) { return }  
  if (!$command) { $command='text' }
  # print " >> $client->{ip}:$client->{port} $command $msg     \n";
  if (!$client || (ref($client) !~ /^gserv\:\:client/) || $client->{killme} || $client->{closed} || $client->{dontsend}) { return }
  if ($client->{sskeactive}) { $msg=sskecrypt($client,$msg,1) }
  my $out=chr(129);
  if ($command eq 'binary') {
    $out=chr(130)
  }
  elsif ($command eq 'pong') {
    if ($client->{verbosepingpong}) {
      $client->{server}->log("*> PONG $client->{ip}\:$client->{port} $msg\n");
    }
    $out=chr(138);
    $client->{lastping}=gettimeofday();
    $client->{pingsent}=0
  }
  elsif ($command eq 'ping') {
    if ($client->{verbosepingpong}) {
      $client->{server}->log("*> PING $client->{ip}\:$client->{port} $msg\n");
    }
    $out=chr(137);
    $client->{pingsent}=0
  }
  elsif ($command eq 'close') {
    $out=chr(136);
    if (!$msg) { $msg="" }
    if ($msg =~ /^([0-9]+) (.+)/) {
      my $code=$1; my $txt=$2; utf8::encode($txt);
      $code=chr($code>>8).chr($code & 255);
      $msg=$code.$txt;
    } else {
      my $code=chr(1000>>8).chr(1000 & 255); utf8::encode($msg);
      $msg=$code.$msg
    }
  }
  my $len=length($msg);
  if ($len<126) {
    $out.=chr($len)
  } elsif ($len<65536) {
    $out.=chr(126);
    $out.=chr($len>>8).chr($len & 255)
  } else {
    $out.=chr(127);
    my $tout=chr(0)x8;
    my $p=7;
    while ($len>0) {
      my $val=$len & 255;
      substr($tout,$p,1,chr($val));
      $len>>=8; $p--;
      if ($p<0) { last } # 128 bit computers ;)
    }
    $out.=$tout;
  }
  $client->out($out.$msg)
}

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

sub decbin {
  # 32 bit decimal->string
  my ($dn) = @_; my $bs=""; my $cnt=4;
  while ($dn>0) {
    my $sn=$dn % 256; 
    $bs=chr($sn).$bs; 
    $dn>>=8; $cnt--;
  }
  $bs=(chr(0)x$cnt).$bs; 
  return $bs
}

sub makewshandshake {
  my ($key1,$key2,$key3) = @_;
  my $sum=md5(decbin($key1).decbin($key2).$key3);
  return $sum;
}

sub decode_websocket {
  my @k=@_;
  my @s=(0,0);
  my @n=("","");
  for (my $i=0;$i<=1;$i++) {
    for (my $c=0;$c<length($k[$i]);$c++) {
      my $cc=substr($k[$i],$c,1);
      if ($cc eq ' ') { $s[$i]++ }
      elsif ($cc =~ /[0-9]/) { $n[$i].=$cc }
      # else negate!!
    }
    if ($s[$i]==0) {
      # This may never be the case!
      return (0,0)
    } else {
      $k[$i]=int $n[$i]/$s[$i];
    }
  }
  return @k
}

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

sub outsock {
  my ($self,$client,$data) = @_;
  if (ref($client) !~ /^gserv\:\:client/) { 
    error("Gserv.OutSock: Client Design error, use gserv::client class input!");
    return 
  }
  return $client->outsock($data)
}

sub out {
  my ($client,$data) = @_;
  if (ref($client) !~ /^gserv\:\:client/) { 
    error("Gserv.Out: Design error, use gserv::client class input!");
    return 
  }
  return $client->out($data)
}

sub burst {
  # burst some output
  my ($client,$data,$killafteroutput) = @_;
  if (ref($client) !~ /^gserv\:\:client/) { 
    error("Gserv.Burst: Design error, use gserv::client class input!");
    return 
  }
  return $client->burst($data,$killafteroutput)
}

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

use threads;
use threads::shared;
use gtfio;
use POSIX qw(:sys_wait_h :errno_h mktime);
my %threaded :shared = ();
my %progress :shared = ();

sub burst_to_client {
  my ($id,$client)=@_;
  my $sz=32768<<2; # 128 Kb Packages
  if (ref($client->{burstdata}) eq 'SCALAR') {
    while ($client->{burstpointer} < $client->{burstlength}) {
      if ($client->{burstpointer}+$sz > $client->{burstlength}) { $sz=$client->{burstlength}-$client->{burstpointer} }
      if ($client->{burstpointer}>=0) {
        $client->outsock(substr(${$client->{burstdata}},$client->{burstpointer},$sz));
      }
      $client->{burstpointer}+=$sz;
      lock(%progress);
      $progress{$id} = $client->{burstpointer};
    }
  }
  elsif($client->{burstfile}) {
    my $f=gfio::open($client->{burstfile},'r');
    while ($client->{burstpointer} < $client->{burstlength}) {
      if ($client->{burstpointer}+$sz > $client->{burstlength}) { $sz=$client->{burstlength}-$client->{burstpointer} }
      $f->seek($client->{burstpointer});
      my $rd=$f->read($sz,1); if ($client->{bursthead}) { $rd=$client->{bursthead}.$rd; delete $client->{bursthead}; }
      $client->outsock($rd);
      $client->{burstpointer}+=$sz;
      lock(%progress);
      $progress{$id} = $client->{burstpointer};
    }
    $f->close();
  }
  lock(%threaded);
  $threaded{$id}++;
}

sub send_to_client {
  my ($id,$client)=@_;
  my $sz=32768<<3; # 256 Kb
  while ($client->{outputpointer} < $client->{outputlength}) {
    if ($client->{outputpointer}+$sz > $client->{outputlength}) { $sz=$client->{outputlength}-$client->{outputpointer} }
    if ($client->{outputpointer}>=0) {
      $client->outsock(substr($client->{outputbuffer},$client->{outputpointer},$sz));
    }
    $client->{outputpointer}+=$sz;
  }
}

sub handleclient {
    my ($self) = @_;
    my $client = $self->{clients}[$self->{current}];
    my $func = $self->{clienthandle};
    my $ctm = gettimeofday();

    if (!defined $client) {
        $self->log("ERROR: No client found at index $self->{current}\n");
        $self->{deleteflag} = 1;
        return;
    }

    if ($client->{closed} || $client->{killme}) {
        $self->deleteclient($client);
        return;
    }

    if ($client->{sslforward}) {
        my $forw = "[$client->{ip}:$client->{port}][HTTP_FORWARD " . $self->httpforward_tohttps($client) . "]";
        if (ref($func) eq 'CODE') {
            &$func($client, 'forward', $forw);
        }
        delete $client->{sslforward};
        return;
    }

    my $sock = $client->{socket};
    if (!$sock) {
        $self->deleteclient($client);
        return;
    }

    $self->{activeclient} = $client;

    if ($self->{timeout} && $client->{init} && $client->{httpreadheader} && ($ctm - $client->{start} > $self->{timeout})) {
        $self->outsock($client, "HTTP/1.1 408 REQUEST TIMEOUT\r\n\r\n");
        if (ref($func) eq 'CODE') {
            &$func($client, 'error', "408 Request Timeout");
        }
        $self->deleteclient($client);
        return;
    }

    if (defined $self->{clientloop} && ref($self->{clientloop}) eq 'CODE') {
        my $loopfunc = $self->{clientloop};
        &$loopfunc($client, 'loop');
        if ($client->{killme}) {
            $self->deleteclient($client);
            return;
        }
    } elsif (defined $self->{clientloop}) {
        error "Invalid loopfunction: $self->{clientloop}";
    }

    # Non-threaded file burst
    if ($client->{burstmode}) {
        my $sz = 32768 << 3; # 256 KB-blokken, zoals outputmode
        if ($client->{burstfile}) {
            my $f = gfio::open($client->{burstfile}, 'r');
            if (!$f) {
                $client->outsock("HTTP/1.1 500 INTERNAL SERVER ERROR\r\n\r\n");
                $client->{killme} = 1;
                return;
            }
            my $canwrite = 0;
            foreach my $handle ($client->{selector}->can_write(0.5)) { # 500ms timeout
                if ($handle == $sock) {
                    $canwrite++;
                    last;
                }
            }
            if ($canwrite) {
                $client->{last} = $ctm;
                if ($client->{burstpointer} < $client->{burstlength}) {
                    if ($client->{burstpointer} + $sz > $client->{burstlength}) {
                        $sz = $client->{burstlength} - $client->{burstpointer};
                    }
                    if (!IO::Socket::connected($sock)) {
                        $f->close();
                        $client->{killme} = 1;
                        return;
                    }
                    $f->seek($client->{burstpointer});
                    my $rd = $f->read($sz, 1);
                    if ($client->{bursthead}) {
                        $rd = $client->{bursthead} . $rd;
                        delete $client->{bursthead};
                    }
                    $client->outsock($rd);
                    if ($client->{killme}) {
                        $f->close();
                        return;
                    }
                    $client->{burstpointer} += $sz;
                    $client->{lastprogress} = $client->{burstpointer};
                    if (ref($func) eq 'CODE') {
                        my $speed = 0;
                        my $delta = $ctm - $client->{last};
                        if ($delta > 0) {
                            $speed = int(10 * (int($client->{burstpointer} / $delta) / 1024)) / 10;
                        }
                        &$func($client, "progress", "$speed Kbs, " . (int((1000 / $client->{burstlength}) * $client->{burstpointer}) / 10) . "%");
                    }
                }
                if ($client->{burstpointer} >= $client->{burstlength}) {
                    $f->close();
                    $client->{burstmode} = 0;
                    if ($client->{killafteroutput}) {
                        $client->{killme} = 1;
                    }
                    if (ref($func) eq 'CODE') {
                        &$func($client, "bursted", $client->{burstlength});
                    }
                }
            }
            $f->close() if !$client->{burstmode};
            return;
        } elsif (ref($client->{burstdata}) eq 'SCALAR') {
            my $canwrite = 0;
            foreach my $handle ($client->{selector}->can_write(0.5)) { # 500ms timeout
                if ($handle == $sock) {
                    $canwrite++;
                    last;
                }
            }
            if ($canwrite) {
                $client->{last} = $ctm;
                if ($client->{burstpointer} < $client->{burstlength}) {
                    if ($client->{burstpointer} + $sz > $client->{burstlength}) {
                        $sz = $client->{burstlength} - $client->{burstpointer};
                    }
                    if (!IO::Socket::connected($sock)) {
                        $client->{killme} = 1;
                        return;
                    }
                    $client->outsock(substr(${$client->{burstdata}}, $client->{burstpointer}, $sz));
                    if ($client->{killme}) {
                        return;
                    }
                    $client->{burstpointer} += $sz;
                    $client->{lastprogress} = $client->{burstpointer};
                    if (ref($func) eq 'CODE') {
                        my $speed = 0;
                        my $delta = $ctm - $client->{last};
                        if ($delta > 0) {
                            $speed = int(10 * (int($client->{burstpointer} / $delta) / 1024)) / 10;
                        }
                        &$func($client, "progress", "$speed Kbs, " . (int((1000 / $client->{burstlength}) * $client->{burstpointer}) / 10) . "%");
                    }
                }
                if ($client->{burstpointer} >= $client->{burstlength}) {
                    $client->{burstmode} = 0;
                    if ($client->{killafteroutput}) {
                        $client->{killme} = 1;
                    }
                    if (ref($func) eq 'CODE') {
                        &$func($client, "bursted", $client->{burstlength});
                    }
                }
            }
            return;
        }
    }

    # Bestaande output- en leeslogica
    if ($client->{outputmode}) {
        my $canwrite = 0;
        foreach my $handle ($client->{selector}->can_write(0.5)) { # 500ms timeout
            if ($handle == $sock) {
                $canwrite++;
                last;
            }
        }
        if ($canwrite) {
            $client->{last} = $ctm;
            for my $i (0..8) { # 2 Mb
                if ($client->{outputpointer} >= $client->{outputlength}) {
                    $client->{outputmode} = 0;
                    if ($client->{killafteroutput} || ($self->{killhttp} && $client->{httpmode})) {
                        if (ref($func) eq 'CODE') {
                            &$func($client, "donesend", $client->{outputlength});
                        }
                        $client->{delete} = 1;
                        return;
                    }
                }
                if ($client->{outputmode}) {
                    my $sz = 32768 << 3; # 256 Kb
                    if ($client->{outputpointer} + $sz > $client->{outputlength}) {
                        $sz = $client->{outputlength} - $client->{outputpointer};
                    }
                    $self->outsock($client, substr($client->{outputbuffer}, $client->{outputpointer}, $sz));
                    if ($client->{killme}) {
                        return;
                    }
                    $client->{outputpointer} += $sz;
                }
            }
        } elsif ($client->{httpmode}) {
            return;
        }
    } else {
        if ($client->{killafteroutput}) {
            $client->{delete} = 1;
            return;
        }
        if ($client->{signalws}) {
            $client->{signalws} = 0;
            if (ref($func) eq 'CODE') {
                &$func($client, 'handshake', 'WebSockets v' . $client->{wsversion});
            }
        }
    }

    # READ
    my $inbuf = "";
    my @ready = $client->{selector}->can_read(0);
    my $canread = 0;
    foreach my $handle (@ready) {
        if ($handle == $sock) {
            $canread = 1;
            last;
        }
    }

    if ($canread) {
        for my $i (1..32) { # 2 Mb
            my $rdbuf = "";
            if ($self->{ssl}) {
                sysread($sock, $rdbuf, 32768); # 32 Kb
            } else {
                recv($sock, $rdbuf, $self->{buffersize}, 0);
            }
            if ($rdbuf eq "") {
                if (($! != POSIX::EAGAIN) && ($! != POSIX::EBUSY) && ($! != POSIX::EWOULDBLOCK) && ($! != 10035)) {
                    if ($!) {
                        my $err = 0 + $!;
                        $self->log("READ ERROR $client->{ip}:$client->{port} [$err] $!");
                        $client->{dontsend} = 1;
                        if (ref($func) eq 'CODE') {
                            &$func($client, 'error', $err);
                        }
                        $self->deleteclient($client);
                        return;
                    }
                }
                last;
            } else {
                $inbuf .= $rdbuf;
            }
        }
    }

    if ($inbuf ne "") {
        my $len = length($inbuf);
        if (ref($func) eq 'CODE') {
            &$func($client, 'received', $len);
        }
        $client->{bytesreceived} += $len;
        $self->log("INBUF: '$inbuf' ($len)\n") if ($self->{debug});

        if ($client->{init}) {
            if (ord(substr($inbuf, 0, 1)) == 255) {
                if ($self->{websocketmode}) {
                    $self->log("ERROR $client->{ip}:$client->{port} [TELNET = NO WEBSOCKET CLIENT]");
                    $self->outsock($client, "HTTP/1.1 400 BAD REQUEST\r\n\r\n");
                    if (ref($func) eq 'CODE') {
                        &$func($client, 'error', "400 Bad Request");
                    }
                    $self->deleteclient($client);
                    return;
                }
                $client->{telnet} = 1;
                if (ref($func) eq 'CODE') {
                    &$func($client, 'telnet');
                }
                $inbuf = "";
                $client->{keepalive} = 1;
                $client->{init} = 0;
                return;
            } elsif ($inbuf =~ /^GET ([^\s]+) HTTP\/([0-1.]+)/i) {
                if ($self->{verboseheader}) {
                    $self->log("GET $1 $2\n");
                }
                my $getstr = $1;
                $client->{httpmode} = 1;
                $client->{httpreadheader} = 1;
                $client->{httpheader}{version} = $2;
                $client->{httpheader}{method} = 'get';
                my ($uri, $cgi) = split(/\?/, $getstr);
                $client->{httpheader}{uri} = $uri;
                $client->{httpheader}{getdata} = $cgi;
            } elsif ($inbuf =~ /^POST ([^\s]+) HTTP\/([0-1.]+)/i) {
                if ($self->{verboseheader}) {
                    $self->log("POST $1 $2\n");
                }
                $client->{httpmode} = 1;
                $client->{httpreadheader} = 1;
                $client->{httpheader}{uri} = $1;
                $client->{httpheader}{version} = $2;
                $client->{httpheader}{method} = 'post';
            } elsif ($inbuf =~ /^SOURCE (\/[^\s]+) ICE\/([0-9.]+)/i) {
                $client->{icecast} = 1;
                $client->{httpreadheader} = 1;
                $client->{mountpoint} = $1;
                $client->{iceversion} = $2;
            } elsif ($self->{websocketmode}) {
                $self->log("ERROR $client->{ip}:$client->{port} [RAW = NO WEBSOCKET CLIENT]");
                $self->outsock($client, "HTTP/1.1 400 BAD REQUEST\r\n\r\n");
                if (ref($func) eq 'CODE') {
                    &$func($client, 'error', 400);
                }
                $self->deleteclient($client);
                return;
            } else {
                if (ref($func) eq 'CODE') {
                    &$func($client, 'error', 405);
                }
                $self->deleteclient($client);
                return;
            }
            $client->{init} = 0;
        }

        $client->{last} = $ctm;

        if ($client->{websockets}) {
            $self->wsinput($client, $inbuf);
        } else {
            if (!$client->{httpmode} && !$client->{telnet} && !$self->{linemode}) {
                if (ref($func) eq 'CODE') {
                    &$func($client, 'input', $inbuf);
                }
                return;
            }
            if ($client->{httpreadheader}) {
                my @hdat = split(/\r\n/, $inbuf, -1);
                my $cnt = 0;
                foreach my $hline (@hdat) {
                    $cnt++;
                    if ($hline eq "") {
                        if ($self->{verboseheader}) {
                            $self->log("HEADER END]\n");
                        }
                        $client->{httpreadheader} = 0;
                        $self->httphandshake($client);
                        if ($client->{killme}) {
                            $self->deleteclient($client);
                            return;
                        }
                        if ($client->{websockets}) {
                            return;
                        }
                        if ($client->{httpheader}{method} eq 'post') {
                            $client->{readpostdata} = 1;
                            $client->{postdatalength} = $client->{httpheader}{'content-length'} || 0;
                            $client->{postdata} = join("\r\n", @hdat[$cnt..$#hdat]);
                            $client->{postdatalength} -= length($client->{postdata});
                            if ($client->{postdatalength} < 0) {
                                $client->{postdata} = substr($client->{postdata}, 0, $client->{postdatalength});
                                $client->{postdatalength} = 0;
                            }
                            if ($client->{postdatalength} == 0) {
                                $client->{readpostdata} = 0;
                                $client->{post} = gpost::init($client->{httpheader}{'content-type'}, $client->{postdata});
                                if (ref($func) eq 'CODE') {
                                    &$func($client, "ready", 'post');
                                }
                            }
                        } else {
                            $client->{post} = gpost::init('get', $client->{httpheader}{getdata});
                            if (ref($func) eq 'CODE') {
                                &$func($client, "ready", 'get');
                            }
                        }
                        last;
                    } else {
                        my ($key, $val) = split(/: /, $hline, 2);
                        if ((defined $key) && ($key ne "")) {
                            if (!defined $val) {
                                $val = "";
                            } else {
                                $val =~ s/^[\s]+//;
                                $val =~ s/[\s]+$//;
                            }
                            $client->{httpheader}{lc($key)} = $val;
                            if ($self->{verboseheader}) {
                                $self->log("[HEADER] '$key' => '$val'\n");
                            }
                        }
                    }
                }
            } elsif ($client->{readpostdata}) {
                $client->{postdata} .= $inbuf;
                $client->{postdatalength} -= length($inbuf);
                if ($client->{postdatalength} < 0) {
                    $client->{postdata} = substr($client->{postdata}, 0, $client->{postdatalength});
                    $client->{postdatalength} = 0;
                }
                if ($client->{postdatalength} == 0) {
                    $client->{readpostdata} = 0;
                    $client->{post} = gpost::init($client->{httpheader}{'content-type'}, $client->{postdata});
                    if (ref($func) eq 'CODE') {
                        &$func($client, "ready", 'post');
                    }
                }
            }
            if ($client->{killme}) {
                $self->deleteclient($client);
                return;
            }
            if (!$client->{readpostdata} && !$client->{httpmode} && !$client->{websockets}) {
                my @lines = split(/\n/, $inbuf);
                foreach my $line (@lines) {
                    $line =~ s/\r//g;
                    if (ref($func) eq 'CODE') {
                        &$func($client, 'input', $line);
                    }
                    if ($client->{killme}) {
                        $self->deleteclient($client);
                        return;
                    }
                }
            }
        }
    } elsif (
        ($self->{idletimeout} && ($ctm - $client->{last} >= $self->{server}{clienttimeout})) ||
        ($self->{server}{clienttimeout} && (!$client->{keepalive} && (gettimeofday() - $client->{last} >= $self->{server}{clienttimeout})))
    ) {
        $client->outsock("HTTP/1.1 408 REQUEST TIMEOUT\r\n\r\n");
        if (ref($func) eq 'CODE') {
            &$func($client, 'error', "408 Request Timeout");
        }
        $self->deleteclient($client);
        return;
    } elsif ($client->{websockets}) {
        if ($client->{pingtime}) {
            my $delta = 0;
            if ($client->{pingsent}) {
                $delta = $ctm - $client->{pingsent};
                if ($delta > $client->{pingtimeout}) {
                    if ($client->{killafteroutput}) {
                        $self->deleteclient($client);
                        return;
                    }
                    wsmessage($client, "2 PING TimeOut", "close");
                    $self->log(">! PING TIMEOUT $client->{ip}:$client->{port}");
                    $client->{killafteroutput} = 1;
                    return;
                }
            }
            $delta = $ctm - $client->{lastping};
            if ($delta > $client->{pingtime}) {
                my $pingmsg = 'eureka' . int(rand(1000000) + 100000);
                $client->{pings}{$pingmsg} = 1;
                wsmessage($client, $pingmsg, 'ping');
                if ($client->{verbosepingpong}) {
                    $self->log("> PING $client->{ip} $client->{port} $pingmsg");
                }
                $client->{pingsent} = $ctm + $client->{pingtime};
                $client->{lastping} = $ctm;
            }
        }
    }
}

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

sub httphandshake {
  my ($self,$client) = @_;
  #my @out=();
  my $sock=$client->{socket};
  if (!$sock) { return }
  my $func=$self->{clienthandle};
  my $date=time2str();
  my $caller=$self->{caller};
  # SSKE Handshake
  if ($client->{sske}) {
    $client->httpversion("1.1");
    if (!$self->checksske($client,$client->{sskemode})) {
      $self->log("[SSKE 460 Keys Expected]\n");
      return $client->httpcode(460)->httprespond(1)
    }
    if (!$self->checksske($client,$client->{sskemode}+1)) {
      $self->log("[SSKE 461 Invalid Keys]\n");
      return $client->httpcode(461)->httprespond(1)
    }
    $client->httpcode(100)
    #push @out,"HTTP/1.1 100 Continue"
  }
  # ICECAST Handshake
  if (!$client->{icecast} && ($client->{httpheader}{'ice-name'} || $client->{httpheader}{'ice-description'} || $client->{httpheader}{'ice-url'})) {
    $client->{icecast}=2;
    $client->{iceversion}=$client->{httpheader}{version};
    $client->{mountpoint}=$client->{httpheader}{uri}
  }
  # Websocket Handshake
  elsif ((defined $client->{httpheader}{upgrade}) && ($client->{httpheader}{upgrade} =~ /websocket/i)) {
    $client->{wsreadheader}=1;
    $client->{wsheadermode}=0;
    $client->{wsdata}="";
    $client->{wsversion}=$client->{httpheader}{'sec-websocket-version'};
    # WebSockets connection, so do handshake!
    # VERSION HyBi 00
    if ($client->{httpheader}{'sec-websocket-key1'}) {
      # hybi00 is vulnerable!!!
      $self->log("[WEBSOCKET HyBi00]\n");
      return $client->httpversion("1.1")->httpcode(400)->httphead("Sec-WebSocket-Version: $client->{wsversion}")->httprespond(1);
    }
    # VERSION HyBi 06
    $client->{websockets}=1;
    $client->{httpmode}=0;
    $client->{websocketprotocol}='hybi06';
    $client->httpversion("1.1")->httpcode(101)->httphead(
      "Upgrade: WebSocket",
      "Connection: Upgrade",
      "Sec-WebSocket-Accept: ".encode_base64(sha1($client->{httpheader}{'sec-websocket-key'}."258EAFA5-E914-47DA-95CA-C5AB0DC85B11"))
    );
    $client->{signalws}=1
  }
  # Websocket Upgrade Error
  elsif ($self->{websocketmode}) {
    #out($client,"HTTP/1.1 426 Upgrade Required\r\nSec-WebSocket-Version: 13\r\nContent-type: text/html\r\n\r\nYou need to connect with the WebSocket protocol on this server.");
    &$func($client,'error',"426 Upgrade Required");
    return $client->httpversion("1.1")->httpcode(426)
      ->httphead("Sec-WebSocket-Version: 13")
      ->contentbody("You need to connect with the WebSocket protocol on this server.")
      ->httprespond(1);
    #$self->deleteclient($client); return
  }
  # ICECAST 1 Handshake
  if ($client->{icecast}==1) {
    $client->httpversion("1.0")->httpcode(200)->httphead(
      "Server: Icecast 2.5.0",
      "Connection: Close",
      "Allow: GET, SOURCE",
      "Date: $date",
      "Cache-Control: no-cache",
      "Pragma: no-cache",
      "Access-Control-Allow-Origin: *"
    );
  }
  # ICECAST 2 Handshake
  elsif ($client->{icecast}==2) {
    $client->httpversion("1.1")->httpcode(100)->httphead(
      "Server: Icecast 2.5.0",
      "Connection: Close",
      "Accept-Encoding: identity",
      "Allow: GET, SOURCE",
      "Date: $date",
      "Cache-Control: no-cache",
      "Pragma: no-cache",
      "Access-Control-Allow-Origin: *"
    );
  }
  # SSKE Handshake
  if ($client->{sske}) {
    if ($client->{sskemode} == 1) {
      $client->httphead(
        "Double-Symmetric-Key: ".octhex(scramblekey($client->{sske}{singlekey},$client->{sske}{transkey},$client->{sske}{transfunc})),
        "Double-Symmetric-Function: ".octhex(scramblekey($client->{sske}{singlefunc},$client->{sske}{transkey},$client->{sske}{transfunc}))
      );
      $client->{httpreadheader}=1;
      $client->{sskemode}=3
    } else {
      $client->{sske}{symkey}=scramblekey($client->{sske}{unlockedkey},$client->{sske}{transkey},$client->{sske}{transfunc});
      $client->{sske}{symfunc}=scramblekey($client->{sske}{unlockedfunc},$client->{sske}{transkey},$client->{sske}{transfunc})
    }
  }
  # Handshake Output
  if ($client->httpcode()){ #$#out >= 0) {
    #my $data=join("\r\n",@out)."\r\n\r\n";
    if ($self->{verboseheader}) {
      $self->log("[HEADER OUT]\n".join("\n",@{$client->httphead()}));
      #print "[HEADER OUT]\n".join("\n",@out)."\n"
    }
    $client->httprespond();
    #out($client,$data);
  }
  # Entering SSKE Mode
  if ($client->{sskemode} > 1) { $client->{sskeactive} = 1 }
}

####### Secure Symmetric Key Exchange #############

sub createkey {
  my ($pubkey, $privkey) = Crypt::Ed25519::generate_keypair;
  return $privkey
}

sub scramblekey {
  # 64 bit CPU-mode only!
  if ($cpu32) { return scramblekey32(@_) }
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('Q*',$private);
  my @flist=unpack('Q*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('Q*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('Q',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub scramblekey32 {
  # 32 bit CPU-mode only!
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('N*',$private);
  my @flist=unpack('N*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('N*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('N',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub sskecrypt {
  # EXTREME strong encoding
  my ($self,$data,$forceencode) = @_;
  my $decode=(substr($data,0,4) eq 'DSKE'); my $ofs=0;
  if ($forceencode) { $decode=0 }
  my $datalen=length($data)-8*$decode; my $orglen=$datalen;
  if ($decode) {
    $orglen=unpack('N',substr($data,4,4)); $ofs=8;
    my $rest=$orglen % 64; if ($rest) { $rest=64-$rest }
    if ($orglen+$rest != $datalen) {
      # Found size ($len) different from actual size ($datalen)
      return undef
    }
  } elsif ($datalen > 16777216) {
    error("Domero Encoder: Datalength exceeds 16Mb.")
  }
  my $sha=sha512($self->{sske}{symkey});
  my $scram; my $kscram;
  if ($datalen > 4096) {
    $scram=sha512($self->{sske}{symfunc});
    if ($datalen > 262144) {
      $kscram=sha512($sha.$scram);
    }
  }
  my $dataoffset=unpack('n',substr($sha,0,2)) % $orglen;
  if (!$decode) { $ofs+=$dataoffset }
  # add padding to get 64 byte granularity
  my $rest=$datalen % 64;
  if ($rest) { $data.=chr(0)x(64-$rest); $datalen+=64-$rest }
  my $nb = $datalen >> 6; my $out=""; my $dat;
  my $filter = $self->{sske}{symfunc};
  for my $b (1..$nb) {
    if (!$decode && ($ofs+64>$datalen)) {
      my $rest=64+$ofs-$datalen;
      $dat=substr($data,$ofs).substr($data,0,$rest); $ofs=$rest
    } else {
      $dat=substr($data,$ofs,64); $ofs+=64
    }
    $out.=scramblekey($dat,$self->{sske}{symkey},$filter);
    $filter=substr($filter,1).substr($filter,0,1);
    if ($b % 64 == 0) {
      # every 4Kb -> new filter (all used up), filter = 64 bytes * 4Kb = max 256Kb
      if ($b % 4096 == 0) {
        # every 256Kb -> new scram (all used up), kscram = 64 bytes * 256Kb = 16Mb
        my @sl=unpack('N*',$kscram); my $ns=""; my $i=0;
        for my $f (unpack('N*',$scram)) {
          $ns.=pack('N',$f ^ $sl[$i]); $i++
        }
        $scram=$ns;
        $kscram=substr($kscram,1).substr($kscram,0,1);
      }
      $filter=""; my $i=0;
      my @sl=unpack('N*',$scram);
      for my $f (unpack('N*',$self->{sske}{symfunc})) {
        $filter.=pack('N',$f ^ $sl[$i]); $i++
      }
      $scram=substr($scram,1).substr($scram,0,1);
    }
  }
  # add header
  if ($decode) {
    # delete encoded zeros padding ( = garbage) and re-adjust data for dataoffset
    $out=substr($out,$datalen-$dataoffset).substr($out,0,$orglen-$dataoffset)
  } else {  
    $out='DSKE'.pack('N',$orglen).$out
  }
  return $out
}

sub checksske {
  my ($self,$client,$mode) = @_;
  if (($mode == 1) || ($mode == 2)) {
    my $key=uc($client->{httpheader}{'symmetric-key'});
    my $fkey=uc($client->{httpheader}{'symmetric-function'});
    if ($mode == 1) {
      if (!$key || !$fkey) { return 0 }
    } else {
      if ($key !~ /[A-F0-9]{128}/) { return 0 }
      if ($fkey !~ /[A-F0-9]{128}/) { return 0 }
      if ($key =~ /^0{128}$/) { return 0 }
      if ($fkey =~ /^0{128}$/ || $fkey =~ /^F{128}$/) { return 0 }
    }
    $client->{sske}{singlekey}=hexoct($key);
    $client->{sske}{singlefunc}=hexoct($fkey)
  } else {
    my $key=uc($client->{httpheader}{'unlocked-symmetric-key'});
    my $fkey=uc($client->{httpheader}{'unlocked-symmetric-function'});
    if ($mode == 3) {
      if (!$key || !$fkey) { return 0 }
    } else {
      if ($key !~ /[A-F0-9]{128}/) { return 0 }
      if ($fkey !~ /[A-F0-9]{128}/) { return 0 }
      if ($key =~ /^0{128}$/) { return 0 }
      if ($fkey =~ /^0{128}$/ || $fkey =~ /^F{128}$/) { return 0 }
    }
    $client->{sske}{unlockedkey}=hexoct($key);
    $client->{sske}{unlockedfunc}=hexoct($fkey)
  }
  return 1
}

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

sub httpresponse {
  my ($code,$version) = @_; my $msg="Unknown"; if (!$version) { $version="1.1" }
  # information
  if ($code == 100) { $msg="Continue" }
  elsif ($code == 101) { $msg="Switching Protocols" }
  elsif ($code == 102) { $msg="Processing" }
  # succesful
  elsif ($code == 200) { $msg="OK" }
  elsif ($code == 201) { $msg="Created" }
  elsif ($code == 202) { $msg="Accepted" }
  elsif ($code == 203) { $msg="Non-Authoritative Information" }
  elsif ($code == 204) { $msg="No Content" }
  elsif ($code == 205) { $msg="Reset Content" }
  elsif ($code == 206) { $msg="Partial Content" } # Streaming content in blocks - RFC 7233
  elsif ($code == 207) { $msg="Multi-Status" } # WebDAV - RFC 4918
  elsif ($code == 208) { $msg="Already Reported" } # WebDAV - RFC 5842
  elsif ($code == 226) { $msg="IM Used" } # RFC 3229
  # redirection
  elsif ($code == 300) { $msg="Multiple Choices" }
  elsif ($code == 301) { $msg="Moved Permanently" }
  elsif ($code == 302) { $msg="Moved Temporary" }
  elsif ($code == 303) { $msg="See Other" }
  elsif ($code == 304) { $msg="Not Modified" } # RFC 7232
  elsif ($code == 305) { $msg="Use Proxy" }
  elsif ($code == 306) { $msg="Switch Proxy" }
  elsif ($code == 307) { $msg="Temporary Redirect" }
  elsif ($code == 308) { $msg="Permanent Redirect" } # RFC 7538
  # client errors
  elsif ($code == 400) { $msg="Bad Request" }
  elsif ($code == 401) { $msg="Unauthorized" }
  elsif ($code == 402) { $msg="Payment Required" }
  elsif ($code == 403) { $msg="Forbidden" }
  elsif ($code == 404) { $msg="Not Found" }
  elsif ($code == 405) { $msg="Method Not Allowed" }
  elsif ($code == 406) { $msg="Not Acceptable" }
  elsif ($code == 407) { $msg="Proxy Authentication Required" }
  elsif ($code == 408) { $msg="Request Timeout" }
  elsif ($code == 409) { $msg="Conflict" }
  elsif ($code == 410) { $msg="Gone" }
  elsif ($code == 411) { $msg="Length Required" }
  elsif ($code == 412) { $msg="Precondition Failed" } # RFC 7232
  elsif ($code == 413) { $msg="Payload Too Large" } # RFC 7231
  elsif ($code == 414) { $msg="URI Too Long" } # RFC 7231
  elsif ($code == 415) { $msg="Unsupported Media Type" }
  elsif ($code == 416) { $msg="Range Not Satisfiable" }
  elsif ($code == 417) { $msg="Expectation Failed" }
  elsif ($code == 418) { $msg="I'm a teapot" } # RFC 2324
  elsif ($code == 421) { $msg="Misdirected Request" } # RFC 7540
  elsif ($code == 422) { $msg="Unprocessable Entity" } # WebDAV - RFC 4918
  elsif ($code == 423) { $msg="Locked" } # WebDAV - RFC 4918
  elsif ($code == 424) { $msg="Failed Dependency" } # WebDAV - RFC 4918
  elsif ($code == 426) { $msg="Upgrade Required" }
  elsif ($code == 428) { $msg="Precondition Required" } # RFC 6585
  elsif ($code == 429) { $msg="Too Many Requests" } # RFC 6585
  elsif ($code == 431) { $msg="Request Header Fields Too Large" } # RFC 6585
  elsif ($code == 451) { $msg="Unavailable For Legal Reasons" } # RFC 7725 Don't burn books :)
  # server errors
  elsif ($code == 500) { $msg="Internal Server Error" }
  elsif ($code == 501) { $msg="Not Implemented" }
  elsif ($code == 502) { $msg="Bad Gateway" }
  elsif ($code == 503) { $msg="Service Unavailable" }
  elsif ($code == 504) { $msg="Gateway Timeout" }
  elsif ($code == 505) { $msg="HTTP Version Not Supported" }
  elsif ($code == 506) { $msg="Variant Also Negotiates" } # RFC 2295
  elsif ($code == 507) { $msg="Insufficient Storage" } # WebDAV - RFC 4918
  elsif ($code == 508) { $msg="Loop Detected" } # WebDAV - RFC 5842
  elsif ($code == 510) { $msg="Not Extended" } # RFC 2774
  elsif ($code == 511) { $msg="Network Authentication Required" } # RFC 6585
  
  return "HTTP/$version $code $msg"
}

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

sub broadcast {
  my ($self,$message)=@_;
  foreach my $c (@{$self->{clients}}) {
    if ($c && !$c->{killme} && !$c->{closed} && !$c->{dontsend}) {
      $c->out($message)
    }
  }
}

sub wsbroadcast {
  my ($self,$message,$command)=@_;
  foreach my $c (@{$self->{clients}}) {
    if ($c->{websockets}) {
      $c->wsmessage($message,$command)
    }
  }
}

sub broadcastfunc {
  my ($self,$func,@data)=@_;
  if (ref($func) ne 'CODE') { error "gserv.broadcastfunc: Not a code reference" }
  foreach my $c (@{$self->{clients}}) {
    if ($c && !$c->{killme} && !$c->{closed} && !$c->{dontsend}) {
      &$func($c,@data)
    }
  }
}

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

sub quit {
  my ($self,$msg)=@_;
  if (!$self->{server}{running}) { exit }
  $|=1; my $nc=$self->{numclients};
  if (!$msg) { $msg="[ no message ]" }
  if (!$nc) { $nc=0 }
  $self->log(prtm(),"Kill signal received!\nQuit: $msg\nKilling $nc clients .. \n");
  $self->wsbroadcast('quit','close');
  for (my $c=0;$c<$nc;$c++) {
    $self->{clients}[$c]{killafteroutput}=1;
  }
  for (my $c=0;$c<$nc;$c++) {
    $self->takeloop()
  }
  $self->log("Done.\n"); $self->log(prtm(),"Killing myself .. ");
  my $sock=$self->{server}{socket};
  if ($sock) { shutdown($sock,2); close($sock); }
  $self->{server}{running}=0;
  $self->{clients} = [];
  $self->{current} = 0;
  $self->{numclients} = 0;
  $self->log("Stopped!\n")
}

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

sub prtm {
  my ($s,$m,$h) = localtime;
  if (length($s)<2) { $s="0$s" }
  if (length($m)<2) { $m="0$m" }
  if (length($h)<2) { $h="0$h" }
  return "[$h:$m:$s] "
}

sub encode_base64_char {
  my ($code,$c62,$c63) = @_;
  if (!$c62) { $c62='+' }
  if (!$c63) { $c63='/' }
  if ($code<26) { return chr(ord('A') + $code) }
  if ($code<52) { return chr(ord('a') + $code-26) }
  if ($code<62) { return chr(ord('0') + $code-52) }
  if ($code==62) { return $c62 }
  if ($code==63) { return $c63 }
  error "Invalid code in Encode Base64 - Must be 0-63! code=$code"
}

sub encode_base64 {
  # RFC 3548
  my ($data) = @_;
  my $c62='+'; my $c63="/";
  my $pad="="; 
  my $len=length($data);
  my $pos=0; my $val=0; my $br=0; my $out=""; my $written=0;
  while ($pos<$len) {
    my $code=ord(substr($data,$pos,1)); $val<<=8; $val+=$code; $br+=8;
    while ($br>=6) {
      my $c=($val>>($br-6)); $br-=6; $val&=((1<<$br)-1);
      $out.=encode_base64_char($c,$c62,$c63); $written++
    }
    $pos++;
  }
  if ($br) {
    $val<<=(6-$br); $out.=encode_base64_char($val,$c62,$c63); $written++;
  }  
  # padding
  while ($written % 4 > 0) {
    $out.=$pad; $written++; 
  }
  return $out
}

sub localip {
  my $socket = IO::Socket::INET->new(
    Proto       => 'udp',
    PeerAddr    => '198.41.0.4', # a.root-servers.net
    PeerPort    => '53', # DNS
  );
  return $socket->sockhost;
}

################################################################################
# EOF gserv.pm (C) 2018 Chaosje @ Domero
################################################################################

package gserv::client;

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

use strict;
use warnings; no warnings qw<uninitialized>;
#use Socket;
#use IO::Socket::IP -register;
#use IO::Handle;
#use IO::Select;
#use IO::Socket::SSL;
#use Time::HiRes qw(usleep gettimeofday);
#use Digest::SHA qw(sha256 sha256_hex sha512);
#use Digest::SHA1 qw(sha1);
#use Digest::MD5 qw(md5);
#use HTTP::Date;
use gerr qw(error);

sub new {
  my ($class,$serv,$client)=@_; if (ref($serv) !~ /^gserv/) { return }
  bless $client,$class;
  push @{$serv->{clients}}, $client;
  $client->{serv}=$serv;
  $serv->{numclients}++;
  $client->{http_response}={ version => "1.1", code => 0, head => [], body => "" };
  if ($serv->{sske}) {
    $client->{sske} = { transkey => gserv::createkey(), transfunc => gserv::createkey() };
    $client->{sskemode}=1
  }
  if ($serv->{verbose}) {
    $serv->log("JOIN $client->{ip}\:$client->{port} ($client->{host})")
  }
  if (ref($serv->{serverhandle}) eq 'CODE') { &{$serv->{serverhandle}}('connect',$client) }
  if (ref($serv->{clienthandle}) eq 'CODE') { &{$serv->{clienthandle}}($client,'connect') }
  return $client
}

sub delete {
  my ($client)=@_;
  $client->{server}->deleteclient($client);
}

################################################################################
# OUTPUT

sub wsmessage { my ($client,@msg)=@_; gserv::wsmessage($client,@msg); return $client }

sub out {
  my ($client,$data,$killafteroutput)=@_;
  if (!defined $data) { return }
  if (ref($data)){ $data=${$data} }
  if ($client->{sskeactive}) { $data=gserv::sskecrypt($client,$data,1) }
  if ($client->{outputmode}) {
    $client->{outputbuffer}.=$data;
    $client->{outputlength}+=length($data);
  } else {
    $client->{outputmode}=1;
    $client->{outputbuffer}=$data;
    $client->{outputlength}=length($data);
    $client->{outputpointer}=0
  }
  if (defined $killafteroutput) { $client->{killafteroutput}=$killafteroutput }
  return $client
}

sub outsock {
    my ($client, $data) = @_;
    if (!$client->{server}{isserver}) {
        error "Design change version 4! \$client->outsock demands the server! Use out or burst instead";
    }
    my $sock = $client->{socket};
    if (!$sock) {
        if (ref($client->{server}{clienthandle}) eq 'CODE') {
            $client->{server}{clienthandle}->($client, 'kill', "no socket");
        }
        $client->{killme} = 1;
        return;
    }
    if (!IO::Socket::connected($sock)) {
        if (ref($client->{server}{clienthandle}) eq 'CODE') {
            $client->{server}{clienthandle}->($client, 'kill', "not connected");
        }
        $client->{killme} = 1;
        return;
    }
    if ($client->{ssl}) {
        my $len = length($data);
        if ($len <= 16384) {
            my $written;
            while (1) {
                $written = syswrite($sock, $data, $len);
                if (defined $written && $written == $len) {
                    last; # Succes
                }
                #$client->{server}->log("ERROR: syswrite failed for client $client->{ip}:$client->{port} [expected $len, wrote " . (defined $written ? $written : "undef") . "] $!");
                if ($! == POSIX::EAGAIN || $! == POSIX::EWOULDBLOCK) {
                    Time::HiRes::usleep(10000); # 10ms wachten bij EAGAIN
                } else {
                    $client->{killme} = 1;
                    return; # Fatale fout
                }
            }
            return;
        }
        my $pos = 0;
        my $sz = 16384;
        while ($pos < $len) {
            if ($pos + $sz > $len) {
                $sz = $len - $pos;
            }
            my $written;
            while (1) {
                $written = syswrite($sock, substr($data, $pos, $sz), $sz);
                if (defined $written && $written == $sz) {
                    last; # Succes
                }
                #$client->{server}->log("ERROR: syswrite failed for client $client->{ip}:$client->{port} [expected $sz, wrote " . (defined $written ? $written : "undef") . "] $!");
                if ($! == POSIX::EAGAIN || $! == POSIX::EWOULDBLOCK) {
                    Time::HiRes::usleep(10000); # 10ms wachten bij EAGAIN
                } else {
                    $client->{killme} = 1;
                    return; # Fatale fout
                }
            }
            $pos += $written;
        }
    } else {
        for my $i (0..length($data)-1) {
            my $chr = substr($data, $i, 1);
            print $sock (ord($chr) < 256 ? $chr : HTML::Entities::encode_entities($chr));
        }
    }
    my $len = length($data);
    $client->{bytessent} += $len;
    if (ref($client->{server}{clienthandle}) eq 'CODE') {
        $client->{server}{clienthandle}->($client, 'sent', $len);
    }
    return $client;
}

sub burst {
  # burst some output
  my ($client,$data,$killafteroutput) = @_;
  if (ref($data) ne "SCALAR") { error("Gserv::Client.Burst: Design error, use \\\$data for much faster comunication!") }
  $client->{burstdata}=$data;
  $client->{burstlength}=length(${$data});
  $client->{burstpointer}=0;
  if ($client->{burstlength}) { $client->{burstmode}=1 }
  if (defined $killafteroutput) { $client->{killafteroutput}=$killafteroutput }
  if (ref($client->{server}{clienthandle}) eq 'CODE') {
    $client->{server}{clienthandle}->($client,'burst',"$client->{burstdata}:$client->{burstlength}:$client->{killafteroutput}:$client->{burstpointer}:".length(${$client->{burstdata}}))
  }
  return $client
}

sub burstfile {
  # burst some output
  my ($client,$head,$file,$killafteroutput,$filter) = @_;
  if (!-f $file) { error("Gserv::Client.BurstFile: File Not Found: $file") }
  $client->{bursthead}=$head;
  $client->{burstfile}=$file;
  $client->{burstfilter}=$filter;
  $client->{burstlength}=-s $file;
  $client->{burstpointer}=0;
  if ($client->{burstlength}) { $client->{burstmode}=1 }
  if (defined $killafteroutput) { $client->{killafteroutput}=$killafteroutput }
  if (ref($client->{server}{clienthandle}) eq 'CODE') {
    $client->{server}{clienthandle}->($client,'burst',"$client->{burstfile}:$client->{burstlength}:$client->{killafteroutput}:$client->{burstpointer}:".(-s $client->{burstfile}))
  }
  return $client
}

################################################################################
# HTTP RESPONSE

sub httpversion {
  my ($client,$version)=@_;
  if (defined $version) {
    $client->{http_response}{version}=$version;
    return $client
  }
  return $client->{http_response}{version}
}

sub httpcode {
  my ($client,$code)=@_;
  if (defined $code) {
    $client->{http_response}{code}=gserv::httpresponse($code,$client->{http_response}{version});
    return $client
  }
  return $client->{http_response}{code} 
}

sub httphead {
  my ($client,@header)=@_;
  if ($#header > -1) {
    push @{$client->{http_response}{head}},@header;
    return $client
  }
  return $client->{http_response}{head}
}

sub contenttype {
  my ($client,$type)=@_;
  if (defined $type) {
    if (!defined $client->{http_response}{type}) {
      $client->{http_response}{type}=$type;
      $client->httphead("Content-type: $client->{http_response}{type}")
    }
    return $client
  }
  return $client->{http_response}{type}
}

sub contentbody {
  my ($client,$body)=@_;
  if (defined $body) {
    $client->{http_response}{length} = length($body);
    $client->httphead("Content-length: $client->{http_response}{length}");
    $client->{http_response}{body} = $body;
    return $client
  }
  return $client->{http_response}{body}
}

sub httpresponse {
  my ($client)=@_;
  if (!defined $client->{http_response}{length} && length($client->{http_response}{body})) {
    $client->{http_response}{length} = length($client->{http_response}{body});
    $client->httphead("Content-length: $client->{http_response}{length}");
    if (!defined $client->{http_response}{type}) { $client->contenttype("text/html") }
  }
  if ($client->{http_response}{code} eq 0) { $client->httpcode(200) }
  return $client->httpcode()."\r\n".join("\r\n",@{$client->httphead()})."\r\n\r\n".$client->contentbody();
}

sub httprespond {
  my ($client,$killafteroutput)=@_;
  return $client->out($client->httpresponse(),$killafteroutput)
}


################################################################################
# EOF gserv::client.pm (C) 2020 OnEhIppY @ Domero
1
```

---

- `gpost.pm`:
```perl
#!/usr/bin/perl

package gpost;

 #############################################################################
 #                                                                           #
 #   Gideon CGI GET POST Engine                                              #
 #   (C) 2018 Domero                                                         #
 #   ALL RIGHTS RESERVED                                                     #
 #                                                                           #
 #############################################################################

use strict;
no strict 'refs';
use warnings;
use gfio;
use gerr qw(error);
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '2.1.2';
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw();

1;

sub init {
  my ($type,$data,$uri) = @_;
  my $self={}; bless $self;
  $self->{key}={};
  $self->{upload}={};
  $self->{fileupload}=0;
  $self->{error}=0;
  $self->{errormsg}="";
  $self->{key}={};
  $self->{boundary}="";
  $self->{data}="";
  $self->{len}=0;
  $self->{reqtype}={};
  if (defined $type) {
    if ($type eq 'get') { $self->{type}='url' }
    elsif ($type =~ /^([^\/]+)\/(.+)$/) {
      my $tp=$1; my $tv=$2;
      $self->{reqtype}{$tp}=$tv;
      if ($tp =~ /application/i){ $self->{type}='url' } 
      elsif ($tp =~ /multipart/i) {
        if ($tv =~ /form-data.*?boundary=\"?([^\"]+)\"?$/i) { $self->{boundary}=$1 }
        $self->{type}='mime'
      }
      elsif ($tp =~ /^text/i) { $self->{type}='url' }
      else {
        $self->{type}='unknown'
      }
    }
    else {
      $self->{error} = 1;
      $self->{errormsg} = "GPost.init: Unknown type found '$type'";
      return $self;  # Early return op error
    }
  }
  if (defined $data) {
    $self->{data}=$data;
  }
  if (!$self->{type}) {
    if ($ENV) {
      $self->{ruri}=[split(/\//,shift(@{[split(/\?/,$uri || $ENV{REQUEST_URI})]}))];
      if ($type || $ENV{'REQUEST_METHOD'} =~ /get/i) {
        $self->{data}=$ENV{'QUERY_STRING'};
        $self->{type}='url'
      } else {
        # Hier de fix: Afvangen van read-failure zonder fatal error
        my $content_length = $ENV{'CONTENT_LENGTH'} || 0;
        my $bytes_read = read(STDIN, $self->{data}, $content_length);
        if ($bytes_read != $content_length) {
          $self->{error} = 1;
          $self->{errormsg} = "Upload not completed (read $bytes_read of $content_length bytes)";
          return $self;  # Graceful return
        }
        if ($ENV{'CONTENT_TYPE'} =~ /application\/x-www-form-urlencoded/i) {
          $self->{type}='url'
        } elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data.*?boundary=\"?([^\"]+)\"?$/i) {
          $self->{boundary}=$1; $self->{type}='mime'
        } else {
          $self->{type}='url'
        }
      }
    }else{
      $self->{ruri}=[];
      $self->{data}=$data;
      $self->{type}='url'
    }
  }
  $self->{len}=length($self->{data});
  if ($self->{error} || (!$self->{len})) { return $self }
  if ($self->{type} eq 'url') {
    $self->decode_url()
  } else {
    $self->decode_mime()
  }
  return $self
}

sub request_uri {
  my ($self,$index)=@_;
  if(defined $index){ return $self->{ruri}[$index] }
  return $self->{ruri}
}

sub ruri { return request_uri(@_) }

sub uploaded {
  my ($self,$formname) = @_;
  if ($self->{upload}{$formname}{length}) {
    return 1
  }
  return 0
}

sub uploadedfile {
  my ($self,$formname) = @_; 
  return $self->{upload}{$formname}{file}
}

sub save {
  my ($self,$formname,$dir,$file) = @_;
  if (!$self->{upload}{$formname}) {
    error("Upload form-field '$formname' does not exist"); return
  }
  if (!$dir) { $dir="." }
  if (substr($dir,length($dir)-1,1) eq '/') { $dir=substr($dir,0,length($dir)-1) }
  my $fnm;
  if (!$file) {
    # save file as given name..
    $fnm="$dir/".$self->{upload}{$formname}{file};
  } else {
    $fnm="$dir/$file";
  }
  gfio::create($fnm,$self->get($formname))
}

sub add {
  my ($self,$key,$val) = @_;
  if (!defined $self->{key}{$key}) {
    $self->{key}{$key}= [ $val ]
  } else {
    push @{$self->{key}{$key}},$val
  }
}

sub set {
  my ($self,$key,$val) = @_;
#  $key=lc($key);
  my $dat=[]; push @{$dat},$val;
  $self->{key}{$key}=$dat
}

sub exist {
  my ($self,$key) = @_;
#  $key=lc($key);
  if (ref($self->{key}{$key})) { return 1 }
  return 0
}

sub exists {
  my $self=shift; return $self->exist(@_)
}

sub get {
  my ($self,$key,$nr) = @_;
  if ($self->{key}{$key}) {
    if ((defined $nr) && ($nr !~ /[^0-9]/)) { return $self->{key}{$key}[$nr] }
    if ($#{$self->{key}{$key}}) {
      return @{$self->{key}{$key}}
    }
    return $self->{key}{$key}[0]
  }
  return undef
}

sub getall {
  my ($self) = @_;
  my $list=[];
  foreach my $key (keys %{$self->{key}}) {
    my $val=$self->{key}{$key};
    if (ref($val) eq 'ARRAY') {
      $val=join(", ",@$val)
    }
    push @$list,{ key => $key, value => $val }
  }
  return $list
}

sub num {
  my ($self,$key) = @_;
#  $key=lc($key);
  return 0+@{$self->{key}{$key}}
}

sub decode_url {
  my ($self) = @_;
  if(defined $self->{data}){
    my @pi=split(/&/,$self->{data});
    foreach my $pe (@pi) {
      my ($ky,$vl)=split(/=/,$pe); # $ky=lc($ky);
      if (defined $vl) { $vl =~ tr/+/ /; $vl=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg }
      $self->add($ky,$vl);
    }
  }
}

sub decode_mime {
  my ($self) = @_;
  # RFC 1867
  # RFC 1521 + 1522
  # * boundary can be "boundary"; 
  #   valid chars are DIGIT / ALPHA / "'" / "(" / ")" / "+" /"_" / "," / "-" / "." / "/" / ":" / "=" / "?"
  # * delimeter := --boundaryCRLF
  # * end-delimeter := --boundary--CRLF
  # * encapsulation := delimiter body-part CRLF (Data must start with delimeter!)
  # * body = multipart/formdata boundary="?boundary"? delimeter blocks end-delimeter
  # * blocks = (Content-....CRLF)* CRLF data
  # * data = Interpreted by Content-Transfer-Encoding header in block

#  if (!$ENV{'REMOTE_ADDR'}) { return }
  my $bsplit=$self->{boundary};
  $bsplit =~ s/\'/\\\'/g;
  $bsplit =~ s/\(/\\\(/g;
  $bsplit =~ s/\)/\\\)/g;
  $bsplit =~ s/\+/\\\+/g;
  $bsplit =~ s/\_/\\\_/g;
  $bsplit =~ s/\,/\\\,/g;
  $bsplit =~ s/\-/\\\-/g;
  $bsplit =~ s/\//\\\//g;
  $bsplit =~ s/\:/\\\:/g;
  $bsplit =~ s/\=/\\\=/g;
  $bsplit =~ s/\?/\\\?/g;

  my $e="Boundary = $self->{boundary}\n";

  # Find end-marker
  my ($parsetext,$exploit) = split(/\-\-$bsplit\-\-[\r|\n]{2}/s,$self->{data});

  if ($exploit) {
    error("Exploit detected in multipart/form-data! <hr><pre>$exploit</pre>"); return
  }

  # Split on delimeters
  my @datablocks = split(/\-\-$bsplit[\r|\n]{2}/s,$parsetext);

  my $numblocks=0+@datablocks;
  my $curblock=1;

  if (!$numblocks) {
    error("No datablocks found in multipart/form-data"); return
  }
  if ($datablocks[0]) {  
    error("Multipart/form-data did not start with a delimeter; can be a virus.<hr><pre>Boundary=$self->{boundary}<hr>$datablocks[0]</pre>")
  }

  shift @datablocks;

  foreach my $b (@datablocks) {
    my $info={};
    while ($b =~ /^Content-(.+)[\r|\n]{2}/i) {
      $e.="<pre> *** Content found: $1</pre><br>";
      $b=substr($b,length($1)+9);
      my $cont=$1;
      my @items = split(/\;/,$cont);
      foreach my $i (@items) {
        $i =~ s/^[\s]+//;
        $e.="<pre>I=$i</pre><br>";
        if ($i =~ /^name=\"(.+?)\"/i) {
          $info->{name}=$1
        } elsif ($i =~ /^filename=\"(.*?)\"/i) {
          $info->{filename}=$1
        } elsif ($i =~ /^Type:\s?(.+)$/i) {
          $info->{type}=$1
        } elsif ($i =~ /^charset=(.+)$/i) {
          $info->{charset}=$1
        } elsif ($i =~ /^Content-transfer-encoding:\s?(.+)$/i) {
          $info->{encoding}=$1
        }
      }
      $e.="<pre>Info found:<br>";
      foreach my $k (keys %{$info}) {
        $e.="$k=\"$info->{$k}\"<br>"
      }
      $e.="<hr width=200 align=left></pre>"
    }
    if ($b !~ /^[\r\n]/) {
      error("Illegal datablock found in block '$curblock'<br><pre>$b</pre>"); return
    }
    if ($b !~ /[\r\n]$/) {
      error("Illegal datablock found in block '$curblock'<br><pre>$b</pre>"); return
    }

    $b=~s/[\r|\n]{2}(.+)[\r|\n]{2}/$1/gs;

    push @{$self->{key}->{$info->{name}}},$b;
    if ($info->{filename}) {
      $self->{fileupload}=1;
      if ($info->{encoding}) {
        # decode
      }
      my $name=$info->{name};
      $self->{upload}{$name} = {
        length => length($b),
        mime => $info->{type},
      };
      my $path=$info->{filename};
      # Delete illegal characters
      $path =~ s/[*?]//g;
      # Decode URL-encoding
      $path =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      # Make spaces -> underscores
      $path =~ s/ /_/g;
      # Make backslashes -> slashes
      $path =~ s/\\/\//g;
      $self->{upload}{$name}{dirfile}=$path;
      my @spath=split(/\//,$path); my $file=pop @spath;
      $self->{upload}{$name}{file}=$file;
      $self->{upload}{$name}{dir}=join("/",@spath);
      my ($rf,$ext) = split(/\./,$file);
      $self->{upload}{$name}{filename}=$rf;
      $self->{upload}{$name}{ext}=$ext;
    }
#    $b =~ s/\r\n/\r\n[enter]/g;
#    $e.="<pre>Data=$b</pre>";
    $curblock++
  }
}

# End of file gpost.pm
```

---

- `gclient.pm`:
```perl
#!/usr/bin/perl

package gclient;

######################################################################
#                                                                    #
#          TCP/IP client                                             #
#           - raw, telnet, HTTP/1.1, WebSockets, IceCast2            #
#           - SSL & SSKE support                                     #
#           - fully bidirectional non-blocking, all systems          #
#           - http reader supports chunked, gzip, auto redirect      #
#           - RSS compatible                                         #
#                                                                    #
#          (C) 2019 Chaosje, Domero                                  #
#          ALL RIGHTS RESERVED                                       #
#                                                                    #
######################################################################

############## Caller Events #########################################
#                                                                    #
#  command    data                                                   #
#  ---------- ------------------------------------------------------ #
#  error      error message                                          #
#  init       called before connect, init variables                  #
#  verboseheader  debug HTTP headers                                 #
#  connect    connection established, you may read and write now     #
#  input      raw byte input received                                #
#  noinput    no input received after read attempt                   #
#  loop       called in every takeloop if loopmode==1 (master mode)  #
#  quit       connection lost                                        #
#                                                                    #
###### HTTP/1.1 ######################################################
#  connected  connection time                                        #
#  request    require request method                                 #
#  header     require header information                             #
#  auth       require authorization information                      #
#  post       set post data                                          #
#  inform     information about server returns                       #
#  reconnect  client has quit, new handle is the parameter           #
#  ready      headers & website has been read                        #
#                                                                    #
###### TELNET ########################################################
#                                                                    #
###### ICECAST 2 #####################################################
#  icemount   mounting info required                                 #
#  icedelay   called every 100msec                                   #
#  icesong    new song info required (for metadata)                  #
#  icedata    new data required                                      #
#                                                                    #
######################################################################
#  N.B. To signal if a socket connection has established,            #
#       use connectcallback, this to not break a server that has a   #
#       client in its loop.                                          #
#                                                                    #
#       When loopmode==0, call $clienthandle->takeloop() as part of  #
#       your own main-loop.                                          #
#                                                                    #
######################################################################

use strict;
no strict 'refs';
use warnings; no warnings qw<uninitialized>;
use Socket;
use utf8;
use gerr qw(error);
use IO::Handle;
use IO::Select;
use IO::Socket;
use IO::Socket::INET;
use IO::Socket::SSL;
use Crypt::Ed25519;
use Digest::SHA qw(sha256 sha256_hex sha512);
use URL::Encode qw(url_encode_utf8);
use MIME::QuotedPrint;
use Exporter;
use Time::HiRes qw(gettimeofday usleep);
use Digest::SHA1 qw(sha1);
use Compress::Bzip2 qw(bzinflateInit);
use Compress::Raw::Zlib;
use Compress::Zlib;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use gparse;

$VERSION     = '9.1.4';
@ISA         = qw(Exporter);
@EXPORT      = qw(out websocket tcpip http wsmsg wsquit wsinput localip telnet website icecast2 icecast2_metadata cpu32);
@EXPORT_OK   = qw(openconnection in spliturl querydata encode_base64);

my $TELNET=telnet_init();
my $cpu32 = (~0 == 4294967295);

1;

sub openconnection {
  # Opens a RAW binary non-blocking bi-directional connection, timeout in seconds.
  my ($host,$port,$linemode,$timeout,$ssl,$connectcallback,$sni) = @_;
  my $self = {}; bless $self;
  if (!$linemode) { $linemode=0 }
  if (!$timeout) { $timeout=10 }

  $self->{error}="";
  $self->{host}=$host;
  $self->{port}=$port;
  $self->{localip}=localip();
  $self->{ssl}=$ssl;
  $self->{timeout}=$timeout;
  $self->{linemode}=$linemode;
  $self->{upgrademode}=0;
  $self->{upgradebuf}="";
  $self->{upgradetime}=0;
  $self->{connected}=0;
  $self->{connecttime}=0;
  $self->{loopmode}=0;
  $self->{protocol}="";
  $self->{websocket}=0;
  $self->{telnet}=0;
  $self->{http}=0;
  $self->{icecast}=0;
  $self->{error}="";
  $self->{quit}=0;
  $self->{caller}=\&dummycaller;
  $self->{buffer}=[];
  $self->{curline}="";
  $self->{dataready}=0;
  $self->{inputfound}=0;
  $self->{output}=0;
  $self->{outputpointer}=0;
  $self->{outputlength}=0;
  $self->{outputbuffer}="";
  $self->{outputlines}=[];
  $self->{connectlooptime}=0.01,
  $self->{waitforinput}=1;
  $self->{connectcallback}=$connectcallback;
  $self->{lastconnect}=gettimeofday();
  $self->{readbufsize}=16384*16;

  # Connect to server
  my $proto = (getprotobyname('tcp'))[2];
  my $iaddr = inet_aton($self->{host});
  my $err=""; my $sock;
  $self->{servervec} = "";

  if ((!defined $iaddr) || (length($iaddr)!=4)) {
    $self->{error}="Unable to resolve IP"; return $self
  } elsif ($ssl) {
    my $sslerr=0;
    if ($sni) {
      $self->{socket}=IO::Socket::SSL->new(
        PeerHost => $self->{host},
        PeerPort => $self->{port},
        SSL_verify_mode => SSL_VERIFY_PEER,
        SSL_verifycn_name => $sni,
        SSL_verifycn_scheme => 'http',
        SSL_hostname => $sni
      ) or $sslerr=1;
    } else {
      $self->{socket}=IO::Socket::SSL->new(
        PeerHost => $self->{host},
        PeerPort => $self->{port},
        SSL_verify_mode => SSL_VERIFY_PEER
      ) or $sslerr=1;
    }
    if ($sslerr) { $self->{error}=$SSL_ERROR; return $self }
    $sock=$self->{socket};
    select($sock); $|=1; select(STDOUT);
    # Set non blocking mode
    $sock->blocking(0);                                             # linux
    my $nonblocking = 1; ioctl($sock, 0x8004667E, \$nonblocking);   # windows

    # Set autoflush on socket
    $sock->autoflush(1);
    #select($self->{socket}); 
    binmode($sock); 

    setsockopt($sock,SOL_SOCKET, SO_RCVTIMEO, 15);
    setsockopt($sock,SOL_SOCKET, SO_SNDTIMEO, 15);
  } else {
    $self->{socket}=undef;
    socket($sock, AF_INET, SOCK_STREAM, $proto) or $err="Cannot create socket on [$host:$port]: $!";
    if ($err) { $self->{error}=$err; return $self }  

    select($sock); $|=1; select(STDOUT);
    # Set non blocking mode
    $sock->blocking(0);                                             # linux
    my $nonblocking = 1; ioctl($sock, 0x8004667E, \$nonblocking);   # windows

    # Set autoflush on socket
    $sock->autoflush(1);
    #select($self->{socket}); 
    binmode($sock); 

    setsockopt($sock,SOL_SOCKET, SO_RCVTIMEO, 15);
    setsockopt($sock,SOL_SOCKET, SO_SNDTIMEO, 15);

    my $paddr = sockaddr_in($self->{port}, $iaddr);

    vec($self->{servervec}, fileno($sock), 1) = 1;
    select(undef, $self->{servervec}, undef, $self->{connectlooptime});
    my $vec=vec($self->{servervec}, fileno($sock), 1);
    if(!connect($sock, $paddr)){
      if ($!{EINPROGRESS}) {
        my $select = IO::Select->new($sock);
        my @ready = $select->can_write($self->{timeout});
        if (!@ready) {
          $err = "Connection timeout or error $! ".(0+$!);
        }
      } else {
        $err = "Could not connect to server [$host:$port]: $! ".(0+$!);
      }
    }
    select(STDOUT); $|=1;
    if ($err) {
      if (($err !~ /\s140$/) && ($err !~ /\s115$/)) {
        shutdown($sock,2); close($sock);
        my ($i,$e) = split(/\]\: /,$err);
        if (($e =~ /no connection/i) && ($e =~ /refused/i)) {
          $err="Remote host is offline"
        } elsif ((($e =~ /forcibly/i) || ($e =~ /closed/i)) && (($e =~ /existing/i) || ($e =~ /established/i))) {
          $err="Lost connection to remote host"
        } elsif (($e =~ /forcibly.*closed/i) || ($e =~ /established.*aborted/i)) {
          $err="Remote host closed the connection"
        }
        $self->{error}=$err; return $self
      }
    }
    $self->{socket}=$sock;
  }

  # Set output to console
  select(STDOUT); if ($::GCLIENT_UTF8) { binmode STDOUT, ":encoding(UTF-8)" } else { binmode STDOUT }; $|=1;

  # selectors are used to poll the pipe if we can read/write, so we don't flood an never waste any time.
  $self->{selector}=IO::Select->new($sock);

  return $self
}

sub connectready {
  # non-blocking connect !
  my ($self) = @_;
  if ($self->{quit}) { return }
  my $sock=$self->{socket};
  if (!$sock) { $self->quit }
  vec($self->{servervec}, fileno($sock), 1) = 1;
  select(undef, $self->{servervec}, undef, $self->{connectlooptime});
  if (vec($self->{servervec}, fileno($sock), 1)) {
    $self->{waitforinput}=0;
    $self->{connecttime}=gettimeofday();
    my $tm=$self->{connecttime}-$self->{lastconnect};
    $self->{connectspeed}=$tm;
    $self->{connected}=1;
    if ($self->{connectcallback}) {
      my $callback=$self->{connectcallback};
      &$callback($self,$tm)
    }
  } elsif ($self->{connected}) {
    my $tm=gettimeofday()-$self->{lastconnect};
    if ($tm>$self->{timeout}) {
      $self->{error}="Could not establish connection to server [$self->{host}:$self->{port}]";
      $self->quit;
    }
  }
}

sub dummycaller {
  my ($client,$cmd,$data) = @_;
}

sub canread {
  my ($self) = @_;
  my $sock=$self->{socket};
  my @ready = $self->{selector}->can_read(0);
  foreach my $handle (@ready) {
    if ($handle == $sock) {
      return 1
    }
  }
  return 0
}

sub canwrite {
  my ($self) = @_;
  my $sock=$self->{socket};
  my @ready = $self->{selector}->can_write(0);
  foreach my $handle (@ready) {
    if ($handle == $sock) {
      return 1
    }
  }
  return 0
}

sub readsocket {
  my ($self,$func) = @_;
  if ($self->{quit}) { return }
  if ($self->{waitforinput}) {
    $self->connectready;    
    if ($self->{waitforinput}) {
      return ""
    }
  }
  my $sock=$self->{socket};
  my $caller=$self->{caller};
  if (!$sock) { 
    &$caller($self,'error',"Socket disconnected");
    $self->{error}="Socket disconnected"; $self->quit; return
  }
  my $buf="";
  if ($self->canread()) {
    if ($self->{ssl}) {
      sysread($sock,$buf,$self->{readbufsize})
    } else {
      recv($sock,$buf,$self->{readbufsize},0)
    }
    if ($self->{debug}) { print STDOUT print "READ: $buf\n" }
    if ($buf eq "") {
      my $err = $! + 0;
      if ($err) {
        if ($self->{debug}) { print STDOUT print "ERR $err\n" }
        if (($! != 11) && ($! != 16)) { # EAGAIN EBUSY
          if ($err == 10035) {
            # 10035 = WSAEWOULDBLOCK (Windows sucking non-blocking sockets)
            return
          } elsif ($err == 140) {
            # 140 = A non-blocking socket operation could not be completed immediately.
            return 
          } elsif ($err == 10053) {
            &$caller($self,'error',"Connection terminated by client");
            $self->{error}="Connection terminated by client"; $self->quit; return
          } elsif ($err == 10054) {
            &$caller($self,'error',"Lost Internet");
            $self->{error}="Lost Internet"; $self->quit; return
          } else {
            # ERROR !
            &$caller($self,'error',"Connection error: [$err] $!");
            $self->{error}="Connection error: [$err] $!"; $self->quit; return
          }
        }   
      } elsif ($self->{dataready} && length($self->{curline})) {
        push @{$self->{buffer}},$self->{curline};
        $self->{curline}="";
      } elsif (!$func) {
        &$caller($self,'noinput');
      } elsif ($self->{lastconnect}) {
        my $tmo=int(gettimeofday() - $self->{lastconnect});
        if ($self->{debug}) { print STDOUT print "\r$tmo" }
        if ($tmo > 10) {
          if (!defined $self->{waitingloop}){ $self->{waitingloop}=0 }
          $self->{waitingloop}++;
          if($self->{waitingloop}>10000) {
            &$caller($self,'error',"Connection Timeout!");
            $self->{error}="Connection Timeout!"; $self->quit; return
          }
        }
      } else {
        $self->{lastconnect}=gettimeofday()
      }
    } else {
      if ($self->{debug}) { print STDOUT "[INPUT-buffer]\n$buf\n[end-INPUT]\n" }
      if (!$self->{linemode}) {
        $self->{dataready}=1;
        $self->{curline}.=$buf
      } else {
        my $data=$self->{curline}.$buf;
        my $line=$self->{curline}; my $pos=length($self->{curline}); my $len=length($data); 
        my $cr=0; if ($pos>0) { if (ord(substr($line,-1)) == 13) { $pos--; $line=substr($line,0,-1); $cr=1 } }
        while ($pos<$len) {
          my $c=substr($data,$pos,1);
          if (ord($c) == 13) {
            if ($cr) { $line.=chr(13) }
            $cr=1;
          } elsif (ord($c) == 10) {
            if ($cr || ($pos+1==$len)) {
              $self->{dataready}=1;
              push @{$self->{buffer}},$line; $line=""
            } else {
              $line.=chr(10)
            }
            $cr=0
          } else {
            if ($cr) { $line.=chr(13) }
            $line.=$c; $cr=0
          }
          $pos++
        }
        if ($cr) { $line.=chr(13) }
        $self->{curline}=$line;
      }
    }
  }
}

sub in {
  my ($self,$func) = @_;
  if ($self->{quit}) { return }
  $self->readsocket($func);
  if (!$self->{dataready}) { return undef }
  if (!$self->{linemode}) {
    my $dat=$self->{curline};
    $self->{curline}="";
    $self->{dataready}=0;
    return $dat
  }  
  my $line=$self->{buffer}[0];
  splice(@{$self->{buffer}},0,1);
  if ($#{$self->{buffer}} < 0) {
    $self->{dataready}=0    
  }
  return $line
}

sub out {
  my ($self,$data) = @_;
  if ($self->{quit}) { return }
  if ($self->{waitforinput}) {
    $self->connectready;    
    if ($self->{waitforinput}) { return }
  }
  if (!defined $data) { return }
  if (!length($data)) { return }
  if (ref($self->{sske}) eq 'HASH' && $self->{sskeactive}) { $data=$self->crypt($data,1) }
  if ($self->{linemode}) {
    $self->{output}=1;
    foreach my $line (split (/\n/,$data)) {
      $line =~ s/\r//g;
      push @{$self->{outputlines}},$line
    }
  } elsif (!$self->{output}) {
    $self->{output}=1;
    $self->{outputbuffer}=$data;
    $self->{outputpointer}=0;
    $self->{outputlength}=length($data)
  } else {
    $self->{outputbuffer}.=$data;
    $self->{outputlength}+=length($data)
  }
}

sub outloop {
  my ($self) = @_;
  if ($self->{quit}) { $self->{output}=0; return }
  if ($self->{waitforinput}) {
    if ($self->{quitting}) { $self->{output}=0; return }
    $self->connectready;    
    if ($self->{waitforinput}) {
      # not connected yet
      return
    }
  }
  if (!$self->{output}) { return }
  my $sz=16384;
  my $sock=$self->{socket};
  if (!$sock || !IO::Socket::connected($sock)) {
    my $caller=$self->{caller};
    $self->{output}=0;
    &$caller($self,'error',"Socket disconnected");
    $self->{error}="Socket disconnected"; $self->quit; return
  }
  if ($self->canwrite) {
    if ($self->{linemode}) {
      my $data=shift @{$self->{outputlines}};
      $data.="\r\n";
      if ($self->{ssl}) {
        syswrite($sock,$data,length($data))
      } else {
        send($sock,$data,0);
      }
      if ($#{$self->{outputlines}}<0) {
        $self->{output}=0
      }
    } elsif ($self->{outputpointer}<$self->{outputlength}) {
      if ($self->{outputlength}-$self->{outputpointer}<$sz) { $sz=$self->{outputlength}-$self->{outputpointer} }
      my $data=substr($self->{outputbuffer},$self->{outputpointer},$sz);
      if ($self->{debug}) { print STDOUT " >> $self->{host} $sz\n" }
      if ($self->{ssl}) {
        syswrite($sock,$data,length($data))
      } else {
        send($sock,$data,0);      
      }
      $self->{outputpointer}+=$sz;
      if ($self->{outputlength}<=$self->{outputpointer}) {
        $self->{output}=0
      }
    } else {
      $self->{output}=0
    }
  }
}

sub outburst {
  my ($self) = @_;
  if (!$self->{burstmode}) {
    $self->{burstmode}=1;
    while ($self->{output}) {
      $self->outloop()
    }
    $self->{burstmode}=0;
  }
}

sub takeloop {
  my ($self) = @_;
  my $caller=$self->{caller};
  if ($self->{quit}) {
    if ($self->{loopmode}) { exit 1 }
    return
  }
  if ($self->{websocket}) { 
    $self->wsinput() 
  } else {
    my $data=$self->in('loop');
    if ($self->{upgrademode}) {
      if (!$data) {
        if (gettimeofday()-$self->{upgradetime}>$self->{timeout}) {
          $self->{error}="WebSocket upgrade timeout";
          &$caller($self,"error","62 WebSocket upgrade timeout");
          $self->quit; return
        }
      } else {
        $self->wsupgrade($data)
      }
    } elsif (defined $data) {
      &$caller($self,"input",$data)
    }
  }
  if ($self->{loopmode}) {
    &$caller($self,"loop");
  }
  $self->outloop()
}

###############################################################################
# Raw TCP/IP                                                                  #
###############################################################################

sub tcpipconnected {
  my ($self,$tm) = @_;
  my $caller=$self->{caller};
  &$caller($self,'connect',$tm)
}

sub tcpip {
  my ($host,$port,$loopmode,$caller,$ssl,$linemode,$timeout,$connectcallback,$sni) = @_;
  if (ref($caller) ne 'CODE') { error "GClient.tcpip: Caller is not a procedure-reference" }
  if (!defined $connectcallback || !$connectcallback || (ref($connectcallback) ne 'CODE')) {
    $connectcallback=\&tcpipconnected
  }  
  my $self=openconnection($host,$port,$linemode,$timeout,$ssl,$connectcallback,$sni);
  $self->{caller}=$caller;
  if ($self->{error}) { &$caller($self,"quit",$self->{error}); $self->quit; return $self }
  if ($loopmode) { $self->{loopmode}=1 }
  &$caller($self,'init',gettimeofday());
  if ($loopmode) {
    while (!$self->{quit}) { $self->takeloop() }
  }
  return $self
}

###############################################################################
# Telnet                                                                      #
###############################################################################

sub telnet {
  # RFC 854 & 855
  my ($host,$port,$loopmode,$caller,$timeout,$ssl,$sni) = @_;
  if (ref($caller) ne 'CODE') { error "GClient.telnet: Caller is not a procedure-reference" }
  if (!$port) { 
    $port=23;
    if ($ssl) { $port=1337 } # as used by stunnel, ssl on telnet is arbitrary
  }
  my $self=openconnection($host,$port,$loopmode,$timeout,$ssl,\&tcpipconnected,$sni);
  $self->{protocol}='telnet'; $self->{telnet}=1;
  $self->{usercaller}=$caller;
  $self->{caller}=\&handle_telnet;
  if ($self->{error}) { &$caller($self,"quit",$self->{error}); $self->quit; return $self }
  if ($loopmode) { $self->{loopmode}=1 }
  $self->{status}={ 
    mode => 'char',
    echo => 1,
    binary => 1,
    localchars => 1,
    buffer => "",
    xpos => 0, ypos => 0,
    width => 80, height => 24
  };
  &$caller($self,'init',gettimeofday());
  if ($loopmode) {
    while (!$self->{quit}) { $self->takeloop() }
  }
  return $self
}

sub handle_telnet {
  my ($self,$command,$data) = @_;
  my $mode=$self->{status}{mode};
  if ($command eq 'input') {
    if ($mode eq 'char') {
      my $chr=ord($data)
    } elsif ($mode eq 'line') {
      my $last=ord(substr($data,-1,1));

    }
    # set line mode

  } elsif ($command eq 'connect') {
    $self->telnet_cmd('DO Binary');
    
  }
}

sub telnet_cmd {
  my ($self,$command) = @_;
  my @list = split(/ /,$command);
  my @bytes = ();
  foreach my $cmd (@list) {
    if ($TELNET->{$cmd}) { push @bytes,$TELNET->{$cmd} }
    else { error "GClient.telnet_cmd: Command '$cmd' unknown in '$command'" }
  }

}

sub telnet_init {
  return {
    NUL => 0, BEL => 7, BS => 8, HT => 9, LF => 10, VT => 11, FF => 12, CR => 13,
    SE => 240, NOP => 241, DataMark => 242, BRK => 243, IP => 244, AO => 245,
    AYT => 246, EC => 247, EL => 248, GA => 249, SB => 250,
    WILL => 251, WONT => 252, DO => 253, DONT => 254, IAC => 255,
    ExtOpt => 255, Binary => 0, Echo => 1, SupGA => 3, Status => 5, TimeMark => 6,
    LineMode => 34, Reconnect => 2, AprSize => 4, RC => 7, OutWidth => 8, OutPageSize => 9,
    OutCR => 10, OutTabStops => 11, OutTab => 12, OutFF => 13, OutVertTabsStops => 14,
    OutVertTab => 15, OutLF => 16, ExtAsc => 17, Logout => 18, ByteMacro => 19,
    DataEntry => 20, SUPDUP => 21, SUPDUPOut => 22, SendLoc => 23, TermType => 24,
    EOR => 25, TACACS => 26, OutMark => 27, TermLoc => 28, '3270' => 29, X3Pad => 30,
    NegWinSize => 31, TermSpeed => 32, RemoteFlow => 33, XDispLoc => 35, EnvOpt => 39,
    AuthOpt => 37
  }
}

###############################################################################
# Hyper Text Transfer Protocol (HTTP) version 1.1                             #
###############################################################################

sub http {
  # RFC 2068, 2616
  # ZLIB RFC 1950, DEFLATE RFC 1951, GZIP RFC 1952
  # Chunked data encoding RFC 2616 3.6.1
  # RFC 2616 14.23 HTTP/1.1 requires request Host 
  my ($host,$port,$loopmode,$caller,$timeout,$ssl,$sni,$sske,$path,$query,$user,$pass) = @_;
  if (ref($caller) ne 'CODE') { error "GClient.http: Caller is not a procedure-reference" }
  if (!$port) { $port=($ssl ? 443:80) }
  if ($path && (substr($path,0,1) ne '/')) { $path='/'.$path }
  my $self=openconnection($host,$port,0,$timeout,$ssl,\&tcpipconnected,$sni);
  $self->{path}=$path; $self->{query}=$query;
  $self->{protocol}='http'; $self->{http}=1;
  $self->{usercaller}=$caller; $self->{sskeround}=1;
  $self->{caller}=\&handle_http;
  if ($self->{error}) { &$caller($self,"quit",$self->{error}); $self->quit; return $self }
  if ($loopmode) { $self->{loopmode}=1 }
  $self->{httpinfo} = {
    request => "", header => {}, postdata => "", wantpost => 0,
    user => $user, pass => $pass,
    response => "", rescode => 0, readhead => 1, reshead => {}, wanted => 0,
    website => "", chunked => 0, chunkmode => 0, chunkhex => "", chunkext => "",
    chunkdata => "", chunksize => 0, encoding => "", trailer => {}
  };
  $self->{sskeactive}=0;
  if ($sske) {
    $self->{sske} = {
      symkey => createkey(),
      symfunc => createkey(),
      transkey => createkey(),
      transfunc => createkey()
    };
    $self->{httpinfo}{header}{'Symmetric-Key'}=octhex(scramblekey($self->{sske}{symkey},$self->{sske}{transkey},$self->{sske}{transfunc}));
    $self->{httpinfo}{header}{'Symmetric-Function'}=octhex(scramblekey($self->{sske}{symfunc},$self->{sske}{transkey},$self->{sske}{transfunc}));
  } else {
    $self->{sskeround} = 9
  }
  # parameters one can change on init event
  $self->{noredirect}=0;
  &$caller($self,'init',gettimeofday());
  if ($loopmode) {
    while (!$self->{quit}) { $self->takeloop() }
  }
  return $self  
}

sub handle_http {
  my ($self,$command,$data) = @_;
  if ($self->{debug} && $command ne 'loop') { print STDOUT "#### $command - $data\n" }
  my $caller=$self->{usercaller};
  if ($command eq 'error') {
    &$caller($self,'error',$data)
  } elsif ($command eq 'connect') {
    if (ref($self->{sske}) ne 'HASH' || ($self->{sskeround} == 1)) {
      &$caller($self,'connected',$data)
    }
    if (!$self->{httpinfo}{request} || (ref($self->{sske}) eq 'HASH' && ($self->{sskeround} == 1))) {
      $self->{httpinfo}{request}="GET / HTTP/1.1";
      $self->{httpinfo}{wantpost}=0;
      if ($self->{debug}) { print STDOUT "[SET-REQUEST][$self->{httpinfo}{request}]\n" }
    }
    if (!$self->{norequest} && (ref($self->{sske}) ne 'HASH' || ($self->{sskeround} > 1))) {
      #if (!$self->{path} && !$self->{query}) {
      &$caller($self,'request');
      #} else {
      #  my $rfunc=$self->{reqmeth}||'';
      #  if ($rfunc && defined &$rfunc) {
      #    &$rfunc($self,$self->{path},$self->{query})
      #  } else {
      #    &$caller($self,'error',"Invalid request method: $rfunc")
      #  }
      #}
      if ($self->{debug}) { print STDOUT "[SET-REQUEST][$self->{httpinfo}{request}]\n" }
      if ($self->{httpinfo}{wantpost}) {
        $self->boundary();
        &$caller($self,'post')
      }
    }
    # store request to detect cyclic redirect loops
    my $hist={ host => $self->{host}, port => $self->{port} };
    if ($self->{history}) {
      push @{$self->{history}},$hist
    } else {
      $self->{history} = [ $hist ]
    }
    if (!$self->{norequest} && (ref($self->{sske}) ne 'HASH' || ($self->{sskeround} > 1))) {
      &$caller($self,'header')
    }
    if (!$self->{httpinfo}{header}{Host} && (!ref($self->{sske}) || ($self->{sskeround} == 1))) {
      # host required in HTTP/1.1
      $self->{httpinfo}{header}{Host}=$self->{host};
    }
    if ($self->{sskeround} > 1) {
      if ($self->{httpinfo}{user} && $self->{httpinfo}{pass}) {
        $self->auth(undef,$self->{httpinfo}{user},$self->{httpinfo}{pass})
      } elsif ($self->{httpinfo}{pass}) {
        $self->auth('bearer',undef,$self->{httpinfo}{pass})
      }
    }
    if ($self->{debug}) { print STDOUT "[handle_http]".gparse::str($self)."\n" }
    $self->sendheader()
  } elsif ($command eq 'input') {
    if ($self->{httpinfo}{chunkmode}) {
      $self->readchunks($data); return
    }
    my @sl=split(/\r\n/,$data,-1); # LIMIT of -1 maintains the presence of undef at end-of-list 
    while ($self->{httpinfo}{readhead}) {
      if ($#sl < 0) { last }
      my $line=shift @sl;
      if (!$self->{httpinfo}{response}) {
        $self->{httpinfo}{response}=$line;
        my ($ver,$code,@txt) = split(/ /,$line);
        $self->{httpinfo}{rescode}=$code;
      } elsif ($line eq "") { 
        $self->{httpinfo}{readhead}=0;
        $self->correctheader();
        $self->handlesske();
        if ($self->{verboseheader}) {
          my @out=("[HEADER IN]");
          for my $k (sort keys %{$self->{httpinfo}{reshead}}) {
            push @out,"$k => ".$self->{httpinfo}{reshead}{$k}
          }
          print STDOUT join("\n",@out)."\n"
        }
        $data=join("\r\n",@sl);
      } else {
        my ($key,@val) = split(/\:/,$line);
        my $v=join(":",@val); $v =~ s/^[\s\t]+//; $v =~ s/[\s\t]+$//;
        $self->{httpinfo}{reshead}{lc($key)}=$v;
        if (lc($key) eq 'content-length') {
          $self->{httpinfo}{wanted}=$v
        } elsif (lc($key) eq 'vary') {
          &$caller($self,'inform','vary '.$v)
        } elsif (lc($key) eq 'content-encoding') {
          $self->{httpinfo}{encoding}=lc($v)
        } elsif (lc($key) eq 'transfer-encoding') {
          if (lc($v) =~ /chunked/i) {
            $self->{httpinfo}{chunked}=1
          }
        } elsif (lc($key) eq 'trailer') {
          $v =~ s/[\s]//; my @tl=split(/\,/,$v);
          for my $t (@tl) {
            $self->{httpinfo}{trailer}{lc($t)}=1
          }
        }
      }
    }

    if (!$self->{httpinfo}{readhead}) {
      if (!$self->{httpinfo}{chunked}) {
        if ($self->{httpinfo}{wanted}) {
          $self->{httpinfo}{website}.=$data;
          if (length($self->{httpinfo}{website}) >= $self->{httpinfo}{wanted}) {
            $self->http_analyse()
          }
        } else {
          # no content-length info whatsoever.. just quit reading
          $self->http_analyse()
        }
      } else {
        $self->{httpinfo}{chunkmode}=1;
        $self->{httpinfo}{chunkdata}="";
        $self->readchunks($data);        
      }
    }
  }
}

sub readchunks {
  my ($self,$data) = @_;
  my $dt=$data; $dt =~ s/\r/\\r/gs; $dt =~ s/\n/\\n/gs;
  $self->{httpinfo}{chunkdata}.=$data;
  $data=$self->{httpinfo}{chunkdata};
  do {
    if ($self->{httpinfo}{chunkmode} == 1) {
      # read chunk (hexsize*[;ext[=val]]CRLF)
      if ($data =~ /^\r\n0[\r\n]*/) {
        $self->http_analyse(); return
      }
      if ($data =~ /^\r\n/) {
        my ($dump,@rest) = split(/\r\n/,$data,-1);
        $data=join("\r\n",@rest);
      }
      if ($data =~ /\r\n/) {
        my ($chunk,@rest) = split(/\r\n/,$data);
        $data=join("\r\n",@rest);
        $self->{httpinfo}{chunkdata}=$data;
        my $hex=""; my @cl = split(//,$chunk);
        for my $i (0..$#cl) {
          if ($cl[$i] =~ /[0-9a-fA-F]/) {
            $hex.=$cl[$i]
          } else {
            $self->{httpinfo}{chunkext}=substr($chunk,$i); last
          }
        }
        $self->{httpinfo}{chunksize}=hex($hex);
        $self->{httpinfo}{chunkmode}=2
      } else {
        # read more data
        return
      }  
    }
    if ($self->{httpinfo}{chunkmode} == 2) {
      # read chunklen data and take as is
      if ($self->{httpinfo}{chunksize}) {
        if (length($data) >= $self->{httpinfo}{chunksize}) {
          $self->{httpinfo}{website}.=substr($data,0,$self->{httpinfo}{chunksize});
          $data=substr($data,$self->{httpinfo}{chunksize});
          $self->{httpinfo}{chunkdata}=$data;
          $self->{httpinfo}{chunkmode}=1
        } else {
          # read more data
          return
        }
      } else {
        if ($data =~ /^\r\n0[\r\n]*/) {
          $self->http_analyse(); return
        }
        if ($data =~ /^\r\n/) {
          my ($dump,@rest) = split(/\r\n/,$data,-1);
          $data=join("\r\n",@rest);
        }
        if ($self->{httpinfo}{trailer}) {
          $self->{httpinfo}{chunkmode}=3;
        } else {
          $self->{httpinfo}{chunkmode}=1
        }
      }
    }
    if ($self->{httpinfo}{chunkmode} == 3) {
      # read trailer
      my @hl = split(/\r\n/,$data,-1);
      for my $line (@hl) {
        if (!$line) { $self->http_analyse(); return }
        my ($key,$val) = split(/\:/,$line); $val =~ s/^[\s]+//; $val =~ s/[\s]+$//;
        if (!$self->{httpinfo}{trailer}{lc($key)}) {
          my $caller=$self->{usercaller};
          &$caller($self,"inform","trailer illegal $key = $val")
        } else {
          $self->{httpinfo}{trailer}{lc($key)}=$val;
          $self->{httpinfo}{reshead}{lc($key)}=$val;
        }
      }
      $self->http_analyse(); return
    }
  } until (0)
}

# POST data

sub boundary {
  my ($self) = @_;
  if ($self->{boundary}) { return }
  my $seed=int (rand(100000000)+12345678); $seed.="Domero";
  foreach my $k (keys %{$self->{httpinfo}{header}}) {
    $seed.=$k.$self->{httpinfo}{header}{$k}
  }
  $self->{boundary}=substr(sha256_hex($seed),10,20);
  $self->sethdr("Content-Type","multipart/form-data; boundary=\"".$self->{boundary}."\"")
}

sub posturl {
  my ($self,$data) = @_;
  my $post=""; my @pl=();
  foreach my $k (keys %$data) {
    push @pl,$k."=".url_encode_utf8($data->{$k})
  }
  $post=join("&",@pl);
  $self->sethdr("Content-Type","application/x-www-form-urlencoded");
  $self->{httpinfo}{postdata}=$post;
  $self->sethdr("Content-Length",length($self->{httpinfo}{postdata}));
}

sub postjson {
  my ($self) = @_;
  $self->sethdr("Content-Type","application/json");
  $self->{httpinfo}{postdata}=JSON->new->allow_blessed->convert_blessed->utf8->canonical->pretty->encode($self->{query});
  $self->sethdr("Content-Length",length($self->{httpinfo}{postdata}));
}

sub postfile {
  my ($self,$type,$data,$encode) = @_;
  # for executables use type 'application/octet-stream' and encode undef
  if (!$encode) { $encode="" } $encode=lc($encode);
  $self->sethdr("Content-Type",$type);
  $self->setcoding($encode);
  $self->{httpinfo}{postdata}=encode($data,$encode);
  $self->sethdr("Content-Length",length($self->{httpinfo}{postdata}));
}

sub postdata {
  # RFC 7578
  my ($self,$name,$value,$filename,$type,$encode) = @_;
  if (!$value) { $value="" }
  my $data="--".$self->{boundary}."\r\nContent-Disposition: form-data";
  if ($name) { $data.="; name=\"$name\"" }
  if ($filename) { $data.="; filename=\"$filename\"" }
  if ($type) { $data.="\r\nContent-Type: $type" }
  if ($encode) {
    if (($encode eq 'base64') || ($encode eq 'quoted-printable') || ($encode eq '8bit') ||
        ($encode eq '7bit') || ($encode eq 'binary')) {
      # HTTP does not use the Content-Transfer-Encoding (CTE) field of RFC 2045.
      # Proxies and gateways from MIME-compliant protocols to HTTP MUST remove any non-identity CTE
      # ("quoted-printable" or "base64") encoding prior to delivering the response message
      # to an HTTP client.
      # (Chaosje) But a lot of servers will understand the CTE, so include it!
      $data.="\r\nContent-Transfer-Encoding: $encode"
    } elsif ($encode) {
      $data.="\r\nContent-Encoding: $encode"
    }
  }
  $self->{httpinfo}{postdata}.=$data."\r\n\r\n".encode($value,$encode)."\r\n";
}

sub postbody {
  my ($self,$mime,$data) = @_;
  if (!$mime) { $mime="text/html" }
  $self->sethdr("Content-Type",$mime);
  $self->{httpinfo}{postdata}=$data;
  my $len=0; if (defined $data) { $len=length($data) }
  $self->sethdr("Content-Length",$len)
}

sub setcharset {
  # RFC 7578 4.6 Set default charset (recommended)
  my ($self,$charset) = @_;
  if (!$charset) { $charset='utf8' }
  my $data="--".$self->{boundary}."\r\nContent-Disposition: form-data; name=\"_charset_\"";
  $self->{httpinfo}{postdata}.=$data."\r\n\r\n".$charset."\r\n"
}

sub postcharset {
  #  RFC 7578 4.5 Set charset for one Content-Disposition (not recommended)
  my ($self,$name,$value,$charset) = @_;
  if (!$value) { $value="" }
  if (!$charset) { $charset='utf8' }
  my $data="--".$self->{boundary}."\r\nContent-Disposition: form-data";
  if ($name) { $data.="; name=\"$name\"" }
  $data.="\r\nContent-Type: text/plain; charset=$charset\r\nContent-Transfer-Encoding: quoted-printable";
  $self->{httpinfo}{postdata}.=$data."\r\n\r\n".encode_qp($value)."\r\n"
}

sub nosniff {
  my ($self) = @_;
  $self->sethdr("X-Content-Type-Options","nosniff")
}

# http-requests

sub get {
  my ($self,$path,$info) = @_;
  req_get($self,'GET',$path,$info);
  return $self
}
sub head {
  # query GET but no response data expected
  my ($self,$path,$info) = @_;
  req_get($self,'HEAD',$path,$info);
  return $self
}
sub post {
  my ($self,$path) = @_;
  req_post($self,'POST',$path);
  return $self
}
sub patch {
  # update some data, 200 = OK, 204 = Not found
  my ($self,$path) = @_;
  req_post($self,'PATCH',$path);
  return $self
}
sub delete {
  # returns 200 = OK, 202 = Accepted, 204 = Not found  
  my ($self,$path) = @_;
  req_post($self,'DELETE',$path);
  return $self
}
sub put {
  # returns 200 = OK, 201 = Created new field, 204 = Not found 
  my ($self,$path) = @_;
  req_post($self,'PUT',$path);
  return $self
}
sub options {
  my ($self,$path) = @_;
  req_post($self,'OPTIONS',$path);
  return $self
}
sub trace {
  # debug POST call, no response data sent
  my ($self,$path) = @_;
  req_post($self,'TRACE',$path);
  return $self
}
sub connect {
  # open bi-directional tunnel to HTTPd
  my ($self,$path) = @_;
  req_post($self,'CONNECT',$path);
  return $self
}
sub source {
  # open bi-directional tunnel to HTTPd
  my ($self,$path,$info) = @_;
  req_get($self,'SOURCE',$path,$info);
  return $self
}

# Request-headers

sub auth {
  # RFC 2617
  my ($self,$method,$login,$pass) = @_;
  if (!$method) { $method='basic' }
  $method=lc($method); 
  if (!$login) { $login=$pass }
  if ($method eq 'basic') {
    my $code = encode_base64($login.":".$pass);
    $self->sethdr("Authorization","Basic $code")
  } elsif ($method eq 'bearer') {
    $self->sethdr("Authorization","Bearer $pass")
  }
  return $self
}

sub agent {
  my ($self,$agent) = @_;
  if (!$agent) { $agent='Mozilla/5.0 (compatible; Domero Perl Client '.$VERSION.')' }
  $self->sethdr('User-Agent',$agent);
  return $self
}
sub setcontent {
  my ($self,$type) = @_;
  if (!$type) { $type="text/html" }
  $self->sethdr("Content-Type",$type);
  return $self
}
sub accept {
  my ($self,$mime) = @_;
  if (!$mime) { $mime='*' }
  $self->setpar("Accept",$mime);
  return $self
}
sub lang {
  my ($self,$lang,$qval) = @_;
  if (!$lang) { $lang='*' }
  $self->setpar('Accept-Language',$lang,$qval);
  return $self
}
sub charset {
  my ($self,$charset,$qval) = @_;
  if (!$charset) { $charset='utf-8' }
  $self->setpar('Accept-Charset',$charset,$qval);
  return $self
}
sub ranges {
  my ($self,$ranges,$qval) = @_;
  if (!$ranges) { $ranges='bytes' }
  $self->setpar('Accept-Ranges',$ranges,$qval);
  return $self
}
sub age {
  my ($self,$age,$qval) = @_;
  if (!$age) { return $self }
  $self->sethdr('Age',$age);
  return $self
}
sub cache {
  # max-age=<seconds>, max-stale[=<seconds>, min-fresh=<seconds>, no-cache,
  # no-store, no-transform, only-if-cached
  my ($self,$cache) = @_;
  if (!$cache) { $cache='max-age=31536000' }
  $self->setpar('Cache-Control',$cache);
  return $self
}
sub nocache {
  my ($self) =@_;
  $self->sethdr('Cache-Control','no-cache');
  return $self
}

# current encoding

sub setcoding {
  my ($self,$code) = @_;
  if (!$code) { return }
  $code=lc($code);
  if (($code eq 'base64') || ($code eq 'quoted-printable') || ($code eq '8bit') ||
      ($code eq '7bit') || ($code eq 'binary') || ($code eq 'x-token')) {
    $self->sethdr("Content-Transfer-Encoding",$code)
  } else {
    $self->sethdr("Content-Encoding",$code);
  }
  return $self
}

# request encoding

sub nocoding {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','identity',$qval);
  return $self
}
sub allcoding {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','*',$qval);
  return $self
}
sub setcompress {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','compress',$qval);
  return $self
}
sub gzip {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','gzip',$qval);
  return $self
}
sub deflate {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','deflate',$qval);
  return $self
}
sub broti {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','br',$qval);
  return $self
}
sub setbzip2 {
  my ($self,$qval) = @_;
  $self->setpar('Accept-Encoding','bzip2',$qval);
  return $self
}
sub trailers {
  my ($self,$qval) = @_;
  $self->setpar('TE','trailers',$qval);
  return $self
}

# calls for website ready

sub response { my ($self) = @_; return $self->{httpinfo}{response} }
sub responsecode { my ($self) = @_; return $self->{httpinfo}{rescode} }
sub headers { my ($self) = @_; return $self->{httpinfo}{reshead} }
sub contenttype { my ($self) = @_; return $self->{httpinfo}{reshead}{'content-type'} }
sub content { my ($self) = @_; return $self->{httpinfo}{website} }

# internal http functions

sub req_get {
  my ($self,$req,$path,$info) = @_;
  if (!$path) { $path='/' }
  $self->{httpinfo}{request}="$req $path";
  if ($info) {
    if (ref($info)) {
      my @kl=keys %$info;
      if ($#kl>=0) {
        $self->{httpinfo}{request}.="?"; my @kv=();
        for my $k (@kl) {
          push @kv,$k."=".url_encode_utf8($info->{$k})
        }
        $self->{httpinfo}{request}.=join('&',@kv)
      }
    } else {
      $self->{httpinfo}{request}.="?$info"
    }
  }
  $self->{httpinfo}{request}.=" HTTP/1.1";
  return $self
}

sub req_post {
  my ($self,$req,$path) = @_;
  if (!$path) { 
    if($self->{debug}) { print "[ReqPost($req):PATH_NOT_SET]\n" }
    $path=$self->{path} || '/'
  }
  $self->{httpinfo}{request}="$req $path HTTP/1.1";
  $self->{httpinfo}{wantpost}=1;
  return $self
}

sub sethdr {
  my ($self,$key,$par) = @_;
  $self->{httpinfo}{header}{$key}=$par;
  return $self
}
sub setpar {
  my ($self,$key,$par,$qval) = @_;
  if ($qval) { $par.=";q=$qval" }
  if ($self->{httpinfo}{header}{$key}) {
    $self->{httpinfo}{header}{$key}.=", $par"
  } else {
    $self->{httpinfo}{header}{$key}=$par
  }
  return $self
}

########## INTERNAL ########################

sub sendheader {
  my ($self) = @_;
  my @data=( $self->{httpinfo}{request} );
  for my $k (keys %{$self->{httpinfo}{header}}) {
    if (defined $k) {
      push @data,$k.": ".($self->{httpinfo}{header}{$k}||'')
    }
  }
  my $rd=join("\r\n",@data)."\r\n\r\n";
  if ($self->{debug}) { print STDOUT "[sendheader]\n$rd\[end]\n" }
  $self->out($rd); $self->takeloop();
  if ($self->{sskeround} > 1) {
    $self->{sskeactive} = 1; # entering DSKE mode
  }
  if ($self->{httpinfo}{postdata}) {
    my $bd=""; if ($self->{boundary}) { $bd="--".$self->{boundary}."--" }
    if ($self->{debug}) { print STDOUT "[postdata]\n$self->{httpinfo}{postdata}$bd\r\n[end]\n" }
    $self->out($self->{httpinfo}{postdata}.$bd."\r\n");
    $self->takeloop()
  }
}

sub correctheader {
  # look for possible conflicts in the header not allowed by the RFC's and correct them
  my ($self) = @_;
  # Content-Length vs. chunked
  if ($self->{httpinfo}{chunked}) {
    if ($self->{httpinfo}{wanted}) {
      $self->{httpinfo}{wanted}=0;
      delete $self->{httpinfo}{reshead}{'content-length'}
    }
  }
}

sub decode {
  my ($self) = @_;
  if ($self->{httpinfo}{encoding} eq 'identity') { return }
  if (($self->{httpinfo}{encoding} eq 'gzip') || ($self->{httpinfo}{encoding} eq 'x-gzip')) {
    $self->{httpinfo}{website}=Compress::Zlib::memGunzip($self->{httpinfo}{website});
  } elsif ($self->{httpinfo}{encoding} eq 'deflate') {
    my $x = new Compress::Raw::Zlib::Inflate( -WindowBits => -MAX_WBIT );
    my $decoded;
    my $status = $x->inflate($self->{httpinfo}{website},$decoded);
    $self->{httpinfo}{website} = $decoded
  } elsif (($self->{httpinfo}{encoding} eq 'compress') || ($self->{httpinfo}{encoding} eq 'x-compress')) {
    my $x = new Compress::Raw::Zlib::Inflate( -WindowBits => WANT_GZIP_OR_ZLIB );
    my $decoded;
    my $status = $x->inflate($self->{httpinfo}{website},$decoded);
    $self->{httpinfo}{website} = $decoded
  } elsif ($self->{httpinfo}{encoding} eq 'bzip2') {
    my $bz; my $status; my $decoded;
    ($bz, $status) = bzinflateInit();
    ($decoded, $status) = $bz->bzinflate($self->{httpinfo}{website});
    $self->{httpinfo}{website} = $decoded
  }
  # Br = Brotli => No Perl implementation found. On todo list. RFC 7932
}

sub http_analyse {
  my ($self) = @_;
  my $caller=$self->{usercaller};
  # guard against exploits and http-data injection
  my $len=length($self->{httpinfo}{website});
  if ($self->{httpinfo}{wanted} && ($self->{httpinfo}{wanted} < $len)) {
    $len-=$self->{httpinfo}{wanted};
    $self->{httpinfo}{exploit}=substr($self->{httpinfo}{website},$self->{httpinfo}{wanted});
    substr($self->{httpinfo}{website},$self->{httpinfo}{wanted},$len,"");
    &$caller($self,'inform',"Exploit found of $len bytes")
  }
  # check errors
  if ($self->{httpinfo}{rescode} == 401) {
    # Authorization required
    my $wanted=$self->{httpinfo}{reshead}{'www-authenticate'};    
    &$caller($self,'auth',$wanted);
    if (!$self->{httpinfo}{header}{'Authorization'}) {
      &$caller($self,"error","Authorization required"); return
    }
    if (!$self->{noredirect}) {
      my $new=http($self->{host},$self->{port},$self->{loopmode},$caller,$self->{timeout},$self->{ssl});
      $self->copyvar($new); $new->{norequest}=1;
      &$caller($self,'reconnect',$new);
    } else {
      &$caller($self,'quit')
    }

  }
  # client errors (4xx) and server errors (5xx)
  if (($self->{httpinfo}{rescode} >= 400) && ($self->{httpinfo}{rescode} <= 599)) {
    &$caller($self,"error",$self->{httpinfo}{response});
    return
  }
  # check redirects
  if (($self->{httpinfo}{rescode} >= 300) && ($self->{httpinfo}{rescode} <= 399)) {
    if (!$self->{httpinfo}{reshead}{location}) {
      &$caller($self,'error',"Location missing on redirect"); return
    }
    &$caller($self,'inform',"redirect $self->{httpinfo}{rescode} $self->{httpinfo}{reshead}{location}");
    my $url=spliturl($self->{httpinfo}{reshead}{location});
    $self->quit();
    # check for cyclic redirect loops
    for my $h (@{$self->{history}}) {
      if (($h->{host} eq $url->{host}) && ($h->{port} eq $url->{port})) {
        &$caller($self,'error',"Cyclic redirect detected on $h->{host}:$h->{port}");
        &$caller($self,"quit")
      }
    }
    # auto redirect
    if (!$self->{noredirect}) {
      my $new=http($url->{host},$url->{port},$self->{loopmode},$caller,$self->{timeout},$url->{ssl});
      $self->copyvar($new); $new->{norequest}=1;
      $new->{history}=$self->{history};
      &$caller($self,'reconnect',$new);
    } else {
      &$caller($self,'quit')
    }
    return
  }
  if ($self->{httpinfo}{encoding}) {
    $self->decode()
  }
  my $tm=gettimeofday()-$self->{connecttime};
  if (ref($self->{sske}) ne 'HASH' || ($self->{sskeround} > 1)) {
    &$caller($self,'ready',$tm)
  } else {
    $self->{sskeround} = 2;
    &{$self->{caller}}($self,'connect',$tm)
  }
}

sub handlesske {
  my ($self) = @_;
  if (ref($self->{sske}) ne 'HASH') { return }
  $self->{httpinfo}{header} = {
    'Unlocked-Symmetric-Key' => octhex(scramblekey(hexoct($self->{httpinfo}{reshead}{'double-symmetric-key'}),$self->{sske}{transkey},$self->{sske}{transfunc})),
    'unlocked-Symmetric-Function' => octhex(scramblekey(hexoct($self->{httpinfo}{reshead}{'double-symmetric-function'}),$self->{sske}{transkey},$self->{sske}{transfunc}))
  };
}

sub copyvar {
  my($self,$new) = @_;
  for my $k (%{$self->{httpinfo}}) {
    if ($k) { $new->{httpinfo}{$k}=$self->{httpinfo}{$k} }
  }  
}

sub spliturl {
  my ($url) = @_;
  my $endslash=0; if (substr($url,-1) eq '/') { $endslash=1 }
  my $info={ scheme => 'http', port => 80, ssl => 0, path => "", query => "" };
  my $data;
  ($data,$url) = split(/\:\/\//,$url);
  if (defined $url) { $info->{scheme}=lc($data) } else { $url=$data }
  if (substr($info->{scheme},-1,1) eq 's') {
    $info->{port}=443; $info->{ssl}=1
  }
  ($data,$url) = split(/\@/,$url);
  if (defined $url) {
    my ($user,$pass) = split(/\:/,$data);
    $info->{user}=$user;
    if (defined $pass) { $info->{password}=$pass }
  } else {
    $url=$data
  }
  ($url,$data) = split(/\#/,$url);
  if (defined $data) {
    $info->{fragment}=$data
  }
  ($url,$data) = split(/\?/,$url);
  if (defined $data) {
    $info->{query}=$data
  }
  my @path; ($url,@path) = split(/\//,$url);
  if ($#path>=0) { $info->{path}=join('/',@path) }
  if ($endslash) { $info->{path}.='/' }
  ($url,$data) = split(/\:/,$url);
  if (defined $data) { $info->{port}=$data }
  $info->{host}=$url;
  return $info
}

sub querydata {
  my ($url)=@_;
  my $info=spliturl($url);
  my $data={};
  for my $item (split/\&/,$info->{query}) {
    my($k,$v)=split(/\=/,$item);
    $data->{$k}=$v
  }
  return $data
}

#### Website/RSS reader ##############################

sub website {
  my ($url,$user,$pass,$timeout) = @_; my $sni;
  my $info=spliturl($url);
  if ($info->{host} =~ /[^0-9\.]/) { $sni=$info->{host} }
  my $self=http($info->{host},$info->{port},1,\&handle_website,$timeout,$info->{ssl},$sni,undef,$info->{path},$info->{query},$user,$pass);
  return $self 
}

sub handle_website {
  my ($self,$command,$data) = @_;
  if ($command eq 'init') {
    $self->{debug}=0;
  } elsif ($command eq 'request') {
    $self->get($self->{path},$self->{query})
  } elsif ($command eq 'header') {
    $self->agent()->lang('*')->allcoding()->charset('*')->cache()
  } elsif ($command eq 'error') {
    $self->quit()
  } elsif ($command eq 'reconnect') {
    $self=$data
  } elsif ($command eq 'ready') {
    $self->quit()
  }   
}

###############################################################################
# IceCast2                                                                    #
###############################################################################

sub icecast2 {
  #   my ($host,$port,$loopmode,$caller,$ssl,$linemode,$timeout,$connectcallback) = @_;
  my ($host,$port,$loopmode,$caller,$timeout,$ssl,$sni) = @_;
  if (ref($caller) ne 'CODE') { error "GClient.icecast2: Caller is not a procedure-reference" }
  if (!$port) { error "GClient.icecast2: No port given" }
  my $self=openconnection($host,$port,0,$timeout,$ssl,\&tcpipconnected,$sni);
  $self->{protocol}='icecast'; $self->{icecast}=1;
  $self->{usercaller}=$caller;
  $self->{caller}=\&handle_icecast2;
  if ($self->{error}) { &$caller($self,"quit",$self->{error}); $self->quit; return $self }
  if ($loopmode) { $self->{loopmode}=1 }
  $self->{iceinfo} = {
    meta => 1, bitrate => 0, samplerate => 0, mountpoint => "",
    login => "source", password => "",
    name => "", desc => "Domero - IceCast 2 stream", url => "", genre => 'Various',
    header => {}, postdata => "", readhead => 1, response => "", responsecode => 0,
    ready => 0, icesong => "", icedata => "", boost => 0, datatime => 0,
    buffersize => 0, framesize => 0, frametime => 0, lasttime => 0
  };
  # parameters one can change on init event
  $self->handle_icecast2('init',gettimeofday());
  if ($loopmode) {
    while (!$self->{quit}) { 
      $self->takeloop();
      if ($self->{iceinfo}{ready}) {
        $self->icecastloop()
      }
    }
  }
  return $self
}

sub takeiceloop {
  my ($self) = @_;
  $self->takeloop();
  if ($self->{iceinfo}{ready}) {
    $self->icecastloop()
  }
}

sub handle_icecast2 {
  my ($self,$command,$data) = @_;
  my $caller=$self->{usercaller};
  if ($command ne 'loop') {
    my $d=$data; if (!$d) { $d='[undef]' }
    # print " > CMD > $command - $d\n"
  }
  if ($command eq 'error') {
    &$caller($self,'error',$data)
  } elsif ($command eq 'init') {
    &$caller($self,'icemount');
    if (!$self->{iceinfo}{bitrate}) { &$caller($self,'error',"No bitrate given") }
    if (!$self->{iceinfo}{samplerate}) { &$caller($self,'error',"No samplerate given") }
    if (!$self->{iceinfo}{mountpoint}) { &$caller($self,'error',"No mountpoint given") }
    if (!$self->{iceinfo}{password}) { &$caller($self,'error',"No password given") }
    $self->{iceinfo}{framesize} = int (144 * $self->{iceinfo}{bitrate} / $self->{iceinfo}{samplerate});
    my $onesec = $self->{iceinfo}{bitrate} >> 3;
    $self->{iceinfo}{frametime} = $self->{iceinfo}{framesize} / $onesec;
    print STDOUT " * framesize = $self->{iceinfo}{framesize}\n * frametime = $self->{iceinfo}{frametime}\n";
  } elsif ($command eq 'connect') {
    &$caller($self,'connected',$data);
    my $auth=encode_base64($self->{iceinfo}{login}.':'.$self->{iceinfo}{password});
    my @header=("SOURCE ".$self->{iceinfo}{mountpoint}." ICE/1.0");
    push @header,"Host: ".$self->{host}.':'.$self->{port};
    push @header,"Authorization: Basic $auth";
    push @header,"User-Agent: Domero gclient/$VERSION";
    push @header,"Accept: */*";
    push @header,"Content-Type: audio/mpeg";
    push @header,"ice-public: 1";
    push @header,"ice-name: ".$self->{iceinfo}{name};
    push @header,"ice-bitrate: ".$self->{iceinfo}{bitrate};
    push @header,"ice-description: ".$self->{iceinfo}{desc};
    push @header,"ice-url: ".$self->{iceinfo}{url};
    push @header,"ice-genre: ".$self->{iceinfo}{genre};
    push @header,"ice-audio-info: ice-samplerate=".$self->{iceinfo}{samplerate}.';ice-bitrate='.$self->{iceinfo}{bitrate}.";ice-channels=2";
    my $head=join("\r\n",@header)."\r\n\r\n";
    $self->out($head);
    $self->takeloop();
  } elsif ($command eq 'input') {
    if ($self->{iceinfo}{ready}) {
      $self->icecastloop()
    } else {
      if ($self->{iceinfo}{readhead}) {
        my @ll = split(/\r\n/,$data,-1); my $idx=0;
        for my $line (@ll) {
          $idx++;
          if ($line eq "") {
            $self->{iceinfo}{readhead} = 0;
            $data=join("\r\n",@ll[$idx..$#ll]);
            last
          } else {
            if (!$self->{iceinfo}{response}) {
              $self->{iceinfo}{response}=$line;
              my @ls=split(/ /,$line); $self->{iceinfo}{responsecode}=$ls[1]
            } else {
              my ($k,$v) = split(/\:/,$line);
              $k =~ s/[\s\t]+$//; $v =~ s/^[\s\t]+//;
              $self->{iceinfo}{header}{lc($k)}=$v
            }
          }
        }
      }
      if (!$self->{iceinfo}{readhead}) {
        $self->{iceinfo}{postdata}.=$data;
        my $len = length($self->{iceinfo}{postdata});
        my $clen = $self->{iceinfo}{header}{'content-length'};
        if (!$clen || ($len == $clen)) {
          my $tm=gettimeofday();
          $self->{icetime}=$tm + 0.1;
          $self->{iceinfo}{ready} = 1;
          $tm-=$self->{connecttime};
          &$caller($self,'ready',$tm)
        }
      }
    }
  }
}

sub icecastloop {
  my ($self) = @_;
  my $tm=gettimeofday();
  my $caller=$self->{usercaller};
  if ($tm >= $self->{icetime}) {
    &$caller($self,'icedelay',$tm);
    $self->{icetime} += 0.1
  }
  if ($self->{iceinfo}{meta} && !$self->{iceinfo}{icesong}) {
    &$caller($self,'icesong')
  }

  # initial boost 0.5 sec data
  if (!$self->{iceinfo}{boost}) {
    my $sz = int ($self->{iceinfo}{framesize} * (0.5 / $self->{iceinfo}{frametime}) );
    &$caller($self,'icedata',$sz);
    $self->out($self->{iceinfo}{icedata});
    $self->{iceinfo}{icedata}="";
    $self->{iceinfo}{buffersize}=0;
    $self->{iceinfo}{boost}=1;
    $self->{iceinfo}{datatime}=$tm + $self->{iceinfo}{frametime}
  }

  # feed server framesize bytes, every frametime sec.
  if ($tm >= $self->{iceinfo}{datatime}) {
    &$caller($self,'icedata',$self->{iceinfo}{framesize});
    $self->out(substr($self->{iceinfo}{icedata},0,$self->{iceinfo}{framesize},""));
    $self->{iceinfo}{buffersize} -= $self->{iceinfo}{framesize};
    $self->{iceinfo}{datatime} += $self->{iceinfo}{frametime}
  }
}

sub icesong {
  my ($self,$song) = @_;
  icecast2_metadata($self->{host},$self->{port},$self->{iceinfo}{mountpoint},$self->{iceinfo}{password},$song)
}

sub icedata {
  my ($self,$data) = @_;
  $self->{iceinfo}{icedata}.=$data;
  $self->{iceinfo}{buffersize}+=length($data)
}

sub ice_nometa {
  my ($self) = @_;
  $self->{iceinfo}{meta}=0
}
sub ice_mount {
  my ($self,$mount) = @_;
  if (!$mount) { $self->setice('mountpoint','') }
  else {
    if (substr($mount,0,1) ne '/') { $mount='/'.$mount }
    $self->setice('mountpoint',$mount)
  }
  return $self
}
sub ice_bitrate {
  my ($self,$bitrate) = @_;
  if (!$bitrate) { $bitrate='128000' }
  if ($bitrate < 1000) { $bitrate *= 1000 }
  $self->setice('bitrate',$bitrate);
  return $self
}
sub ice_samplerate {
  my ($self,$samplerate) = @_;
  if (!$samplerate) { $samplerate='44100' }
  if ($samplerate < 1000) { $samplerate *= 1000 }
  $self->setice('samplerate',$samplerate);
  return $self
}
sub ice_password {
  my ($self,$pass) = @_;
  $self->setice('password',$pass);
  return $self
}
sub ice_name {
  my ($self,$name) = @_;
  $self->setice('name',$name);
  return $self
}
sub ice_desc {
  my ($self,$desc) = @_;
  $self->setice('desc',$desc);
  return $self
}
sub ice_genre {
  my ($self,$genre) = @_;
  $self->setice('genre',$genre);
  return $self
}
sub ice_url {
  my ($self,$url) = @_;
  $self->setice('url',$url);
  return $self
}
sub ice_login {
  my ($self,$login) = @_;
  if (!$login) { $login='source' }
  $self->setice('login',$login);
  return $self
}
sub setice {
  my ($self,$tag,$value) = @_;
  $self->{iceinfo}{$tag}=$value;
  return $self
}

sub ice_headers {
  my ($self) = @_;
  return $self->{iceinfo}{header}
}
sub ice_response {
  my ($self) = @_;
  return $self->{iceinfo}{response}
}
sub ice_responsecode {
  my ($self) = @_;
  return $self->{iceinfo}{responsecode}
}
sub ice_postdata {
  my ($self) = @_;
  return $self->{iceinfo}{postdata}
}

sub icecast2_metadata {
  my ($host,$port,$mount,$pass,$song) = @_;
  $mount =~ s/^\///;
  $song=url_encode_utf8($song);
  website("$host:$port/admin/metadata?pass=$pass&mode=updinfo&mount=/$mount&song=$song")
}

###############################################################################
# WebSockets                                                                  #
###############################################################################

sub starthandshake {
  my ($self,$ctm) = @_;
  my $tm=gettimeofday();
  my $hash=sha1("Domero".$tm."Domero");
  my $handshake = encode_base64($hash);
  $self->{handshake}=$handshake;
  my $out=<<EOT;
GET /chat HTTP/1.1
Host: $self->{host}
Upgrade: websocket
Connection: Upgrade
Sec-WebSocket-Key: $handshake
Origin: http://$self->{localip}
Sec-WebSocket-Protocol: chat, superchat
Sec-WebSocket-Version: 13

EOT
  $out =~ s/\n/\r\n/g;
  $self->out($out);
  $self->outburst;
  $self->{upgradetime}=gettimeofday();  
}

sub websocket {
  my ($host,$port,$loopmode,$caller,$ssl,$timeout,$sni,$sske) = @_;
  if (!defined $caller || (ref($caller) ne 'CODE')) { error "GClient.websocket: Caller is not a procedure-reference" }
  my $self=openconnection($host,$port,0,$timeout,$ssl,\&starthandshake,$sni);
  if ($self->{error}) { &$caller($self,"quit",$self->{error}); $self->quit; return $self }
  $self->{caller}=$caller;
  $self->{sske} = {
    symkey => createkey(),
    symfunc => createkey(),
    transkey => createkey(),
    transfunc => createkey()
  };
  my $skey = octhex(scramblekey($self->{sske}{symkey},$self->{sske}{transkey},$self->{sske}{transfunc}));
  my $fkey = octhex(scramblekey($self->{sske}{symfunc},$self->{sske}{transkey},$self->{sske}{transfunc}));
  $self->{httpinfo}{header}{'Symmetric-Key'}=$skey;
  $self->{httpinfo}{header}{'Symmetric-Function'}=$fkey;
  $self->{sskeround}=1; $self->{sskeactive}=0;
  &$caller($self,'init');
  $self->{upgradetime}=gettimeofday();  
  $self->{upgrademode}=1;
  if ($loopmode) {
    $self->{loopmode}=1;
    while (!$self->{quit}) {
      $self->takeloop()
    }
  }
  return $self
}

sub wsupgrade {
  # RFC 6455
  my ($self,$data) = @_;
  my $caller=$self->{caller};
  if ($data !~ /\r\n\r\n/) {
    $self->{upgradebuf}.=$data; return
  }
  $data=$self->{upgradebuf}.$data;
  $self->{upgrademode}=0;
  my ($response,@wsd) = split(/\r\n\r\n/,$data);
  my $wsdata=join("\r\n\r\n",@wsd);
  # reactivate writing server -> client
  $self->{ws}={ upgraded => 0 }; $response =~ s/\r//g;
  foreach my $line (split(/\n/,$response)) {
    if ($self->{debug}) { print STDOUT "$line\n" }
    if ($line =~ /^http\/1\.. ([0-9]+)/i) { $self->{ws}{httpstatus}=$1 }
    if ($line =~ /^Sec-WebSocket-Accept: (.+)$/i) { $self->{ws}{key}=$1 }
    if ($line =~ /^upgrade: websocket/i) { $self->{ws}{upgraded}=1 }
  }
  if (!$self->{ws}{upgraded}) { &$caller($self,"error","Could not upgrade protocol to WebSocket"); $self->quit; return }
  if (!$self->{ws}{httpstatus} || $self->{ws}{httpstatus} != 101) { &$caller($self,"error","Could not switch protocols"); $self->quit; return }
  my $handshake=$self->{handshake};
  $handshake.="258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
  $handshake = sha1($handshake);
  $handshake = encode_base64($handshake);
  if ((!$self->{ws}{key}) || ($self->{ws}{key} ne $handshake)) { &$caller($self,"error","Server WebSocket key is invalid"); $self->quit; return }
  $self->{websocket}=1; $self->{ws} = { buffer => "", data => "", type => "" };
  &$caller($self,"connect",gettimeofday." ".$self->{host}.":".$self->{port});
  if ($wsdata) {
    $self->wsinput($wsdata)
  }
}

sub wsinput {
  # RFC 6455
  my ($self,$data,$try) = @_;
  if (!$data) {
    $data=$self->in('websocket');
    if (defined $data) { $self->{ws}{buffer}.=$data }
  } else {
    $self->{ws}{buffer}.=$data
  }
  my $blen=length($self->{ws}{buffer});
  if ($blen < 2) { return }
  if ($self->{debug}) { print STDOUT " << INPUT [$blen] $self->{host}:$self->{port}     \n" }
  my $caller=$self->{caller};
  my $firstchar=ord(substr($self->{ws}{buffer},0,1));
  my $secondchar=ord(substr($self->{ws}{buffer},1,1));
  my $type=$firstchar & 15;
  my $final=$firstchar & 128;
  my $continue=0;
  my $blocktype;
  if ($type == 0) { $continue=1 }
  elsif ($type == 1) { $blocktype='text' }
  elsif ($type == 2) { $blocktype='binary' }
  elsif ($type == 8) { $blocktype='close' }
  elsif ($type == 9) { $blocktype='ping' }
  elsif ($type == 10) { $blocktype='pong' }
  else {
    &$caller($self,'error',"Invalid WS frame type: $type"); return
  }
  if (!$continue) { $self->{ws}{type}=$blocktype }
  my $mask=$secondchar & 128;
  if ($mask) {
    # RFC 6455 - Data MAY NOT be masked!
    &$caller($self,'error',"Masked data found in input from server"); return
  }
  my $len=$secondchar & 127; my $offset=2;
  if ($len==126) {
    if ($blen < 4) { return }
    $len=ord(substr($self->{ws}{buffer},2,1));
    $len=($len<<8)+ord(substr($self->{ws}{buffer},3,1));
    $offset=4
  } elsif ($len==127) {
    if ($blen < 10) { return }
    $len=0;
    for (my $p=0;$p<8;$p++) {
      $len=($len<<8)+ord(substr($self->{ws}{buffer},$offset,1));
      $offset++
    }
  }
  if ($blen<$offset+$len) { return }
  # YES! We got a package!
  my $fdata=substr($self->{ws}{buffer},$offset,$len);
  $self->{ws}{data}.=$fdata;
  if ($final) {
    $self->handlews($self->{ws}{type},$self->{ws}{data});
    $self->{ws}{data}=""
  }
  $self->{ws}{buffer}=substr($self->{ws}{buffer},$offset+$len);
  if (length($self->{ws}{buffer}) && !$try) { $self->wsinput(undef,1) }
}

sub handlews {
  my ($self,$type,$msg) = @_;
  if ($self->{debug}) { print STDOUT print " < WS $type $msg      \n" }
  if ($self->{sskeactive}) { $msg=$self->crypt($msg,0) }
  my $caller=$self->{caller};
  if ($type eq 'close') {
    utf8::decode($msg);
    my $code=(ord(substr($msg,0,1))<<8)+ord(substr($msg,1,1));
    $msg=substr($msg,2); if (!$msg) { $msg="Quit" }
    &$caller($self,'quit',"$code $msg");
    if ($self->{verbose}) { print STDOUT "\nWebSocket server has closed the connection: $code $msg\n" }
    $self->quit    
  } elsif ($type eq 'ping') {
    $self->wsout($msg,'pong');
    if ($self->{debug}) { print STDOUT print "> PONG $msg\n" }
  } elsif ($type eq 'pong') {
    # bi-directional ping/pong ? that takes balls !
  } else {
    &$caller($self,'input',$msg)
  }
}

sub wsmsg {
  my ($self,$msg) = @_;
  $self->wsout($msg,'input')
}

sub wsquit {
  my ($self,$msg) = @_;
  $self->wsout($msg,'close');
  $self->outburst();
  $self->{killafteroutput}=1;
}

sub wsout {
  # RFC 6455
  my ($self,$msg,$type) = @_;
  if (!defined $msg) { $msg="" }
  if ($self->{sskeactive}) { $msg=$self->crypt($msg,1) }
  my $len=length($msg);
  if (!$type) { $type = 'text' }
  my $tp=1;
  if ($type eq 'binary') { $tp=2 }
  elsif ($type eq 'close') { $tp=8 }
  elsif ($type eq 'ping') { $tp=9 }
  elsif ($type eq 'pong') { $tp=10 }
  if ((($tp==1) || ($tp==2)) && (length($msg) == 0)) { return } # ignore empty text/binary blocks
  my $out=chr($tp | 128); # 128 = final frame flag
  if ($len<126) {
    $out.=chr($len | 128) # 128 = mask is present
  } elsif ($len<65536) {
    $out.=chr(254);
    $out.=chr($len >> 8).chr($len & 255)
  } else {
    $out.=chr(255);
    $out.=chr(($len >> 56) & 255).chr(($len >> 48) & 255).chr(($len >> 40) & 255).chr(($len >> 32) & 255).chr(($len >> 24) & 255).chr(($len >> 16) & 255).chr(($len >> 8) & 255).chr($len & 255)    
  }
  my $mask=int rand(65536);
  $mask=($mask<<8) + int rand(65536);
  my $mask2=int rand(65536);
  $mask2=($mask2<<8) + int rand(65536);
  $mask = $mask ^ $mask2;
  my @mask=();
  for (my $i=0;$i<4;$i++) {
    push @mask,$mask & 255; $out.=chr($mask & 255); $mask>>=8
  }
  for (my $p=0;$p<$len;$p++) {
    $out.=chr(ord(substr($msg,$p,1)) ^ $mask[$p % 4])
  }
  if ($self->{debug}) { print STDOUT "> OUT: $msg ($type)\n" }
  $self->out($out);
  if ($type eq 'close') { $self->quit }
}

sub quit {
  my ($self) = @_;
  $self->{quitting}=1;
  if ($self->{quit}) { return }
  $self->outburst;
  if (defined $self->{socket}) {
    if ($self->{socket} && IO::Socket::connected($self->{socket})) {
      if ($self->{ssl}) {
        $self->{socket}->close(SSL_no_shutdown => 1)
      } else {
        shutdown($self->{socket},2); close($self->{socket}) 
      }
    }
  }
  $self->{quit}=1
}

###############################################################################
# Global functions                                                            #
###############################################################################

sub createkey {
  my ($pubkey, $privkey) = Crypt::Ed25519::generate_keypair;
  return $privkey
}

sub scramblekey {
  # 64 bit CPU-mode only!
  if ($cpu32) { return scramblekey32(@_) }
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('Q*',$private);
  my @flist=unpack('Q*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('Q*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('Q',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub scramblekey32 {
  # 32 bit CPU-mode only!
  my ($shared,$private,$fkey) = @_;
  my @plist=unpack('N*',$private);
  my @flist=unpack('N*',$fkey);
  my $key=""; my $i=0;
  for my $c (unpack('N*',$shared)) {
    my $x = $c ^ $plist[$i];
    $key.=pack('N',(($x & ~$flist[$i]) | (~$x & $flist[$i])));
    $i++
  }
  return $key
}

sub crypt {
  # EXTREME strong encoding
  my ($client,$data,$forceencode) = @_;
  my $decode=(substr($data,0,4) eq 'DSKE'); my $ofs=0;
  if ($forceencode) { $decode=0 }
  my $datalen=length($data)-8*$decode; my $orglen=$datalen;
  if ($decode) {
    $orglen=unpack('N',substr($data,4,4)); $ofs=8;
    my $rest=$orglen % 64; if ($rest) { $rest=64-$rest }
    if ($orglen+$rest != $datalen) {
      # Found size ($len) different from actual size ($datalen)
      return undef
    }
  } elsif ($datalen > 16777216) {
    error("Domero Encoder: Datalength exceeds 16Mb.")
  }
  # Validate keys: reject zero or predictable function keys
  my $hexkey=unpack('H*',$client->{sske}{symkey});
  my $hexfkey=unpack('H*',$client->{sske}{symfunc});
  if ($hexkey =~ /^0{128}$/) { return undef }
  if ($hexfkey =~ /^0{128}$/ || $hexfkey =~ /^f{128}$/i) { return undef }
  my $sha=sha512($client->{sske}{symkey});
  my $scram; my $kscram;
  if ($datalen > 4096) {
    $scram=sha512($client->{sske}{symfunc});
    if ($datalen > 262144) {
      $kscram=sha512($sha.$scram);
    }
  }
  my $dataoffset=unpack('n',substr($sha,0,2)) % $orglen;
  if (!$decode) { $ofs+=$dataoffset }
  # add padding to get 64 byte granularity
  my $rest=$datalen % 64;
  if ($rest) { $data.=chr(0)x(64-$rest); $datalen+=64-$rest }
  my $nb = $datalen >> 6; my $out=""; my $dat;
  my $filter = $client->{sske}{symfunc};
  for my $b (1..$nb) {
    if (!$decode && ($ofs+64>$datalen)) {
      my $rest=64+$ofs-$datalen;
      $dat=substr($data,$ofs).substr($data,0,$rest); $ofs=$rest
    } else {
      $dat=substr($data,$ofs,64); $ofs+=64
    }
    $out.=scramblekey($dat,$client->{sske}{symkey},$filter);
    $filter=substr($filter,1).substr($filter,0,1);
    if ($b % 64 == 0) {
      # every 4Kb -> new filter (all used up), filter = 64 bytes * 4Kb = max 256Kb
      if ($b % 4096 == 0) {
        # every 256Kb -> new scram (all used up), kscram = 64 bytes * 256Kb = 16Mb
        my @sl=unpack('N*',$kscram); my $ns=""; my $i=0;
        for my $f (unpack('N*',$scram)) {
          $ns.=pack('N',$f ^ $sl[$i]); $i++
        }
        $scram=$ns;
        $kscram=substr($kscram,1).substr($kscram,0,1);
      }
      $filter=""; my $i=0;
      my @sl=unpack('N*',$scram);
      for my $f (unpack('N*',$client->{sske}{symfunc})) {
        $filter.=pack('N',$f ^ $sl[$i]); $i++
      }
      $scram=substr($scram,1).substr($scram,0,1);
    }
  }
  # add header
  if ($decode) {
    # delete encoded zeros padding ( = garbage) and re-adjust data for dataoffset
    $out=substr($out,$datalen-$dataoffset).substr($out,0,$orglen-$dataoffset)
  } else {  
    $out='DSKE'.pack('N',$orglen).$out
  }
  return $out
}

sub octhex {
  my ($key) = @_;
  if (!defined $key) { return "" }
  my $hex;
  for (my $i=0;$i<length($key);$i++) {
    my $c=ord(substr($key,$i,1));
    $hex.=sprintf('%02X',$c);
  }
  return $hex  
}

sub hexoct {
  my ($hex) = @_;
  if (!defined $hex) { return "" }
  my $key="";
  for (my $i=0;$i<length($hex);$i+=2) {
    my $h=substr($hex,$i,2);
    $key.=chr(hex($h));
  }
  return $key
}

sub encode_base64_char {
  my ($code,$c62,$c63) = @_;
  if (!$c62) { $c62='+' }
  if (!$c63) { $c63='/' }
  if ($code<26) { return chr(ord('A') + $code) }
  if ($code<52) { return chr(ord('a') + $code-26) }
  if ($code<62) { return chr(ord('0') + $code-52) }
  if ($code==62) { return $c62 }
  if ($code==63) { return $c63 }
  error "Invalid code in Encode Base64 - Must be 0-63! code=$code"
}

sub encode_base64 {
  # RFC 3548
  my ($data) = @_;
  my $c62='+'; my $c63="/";
  my $pad="="; 
  my $len=length($data);
  my $pos=0; my $val=0; my $br=0; my $out=""; my $written=0;
  while ($pos<$len) {
    my $code=ord(substr($data,$pos,1)); $val<<=8; $val+=$code; $br+=8;
    while ($br>=6) {
      my $c=($val>>($br-6)); $br-=6; $val&=((1<<$br)-1);
      $out.=encode_base64_char($c,$c62,$c63); $written++
    }
    $pos++;
  }
  if ($br) {
    $val<<=(6-$br); $out.=encode_base64_char($val,$c62,$c63); $written++;
  }  
  # padding
  while ($written % 4 > 0) {
    $out.=$pad; $written++; 
  }
  return $out
}

sub encode {
  my ($data,$encode) = @_;
  if (!$encode) { return $data }
  if (($encode eq 'gzip') || ($encode eq 'x-gzip')) {
    return Compress::Zlib::memGzip($data);
  } elsif ($encode eq 'deflate') {
    my $x = new Compress::Raw::Zlib::Deflate( -WindowBits => -MAX_WBIT );
    my ($output, $status);
    $status = $x->deflate($data,$output);
    $status = $x->flush($output);
    return $output
  } elsif (($encode eq 'compress') || ($encode eq 'x-compress')) {
    my $x = new Compress::Raw::Zlib::Deflate( -WindowBits => WANT_GZIP_OR_ZLIB );
    my ($output, $status);
    $status = $x->deflate($data,$output);
    $status = $x->flush($output);
    return $output
  } elsif ($encode eq 'bzip2') {
    my ($bz, $status) = bzdeflateInit(); my $decoded;
    ($decoded, $status) = $bz->bzdeflate($data);
    return $decoded
  } elsif ($encode eq 'base64') {
    return encode_base64($data)
  } elsif ($encode eq 'quoted-printable') {
    return encode_qp($data)
  } elsif ($encode eq '7bit') {
    my $out=""; 
    for my $line (split(/\n/,$data)) {
      my $len=length($line); my $i=0; my $cl="";
      while ($i<$len) {
        $cl.=chr(ord(substr($line,$i,1)) & 127); $i++
      }
      while (length($cl) > 1000) {
        $out.=substr($cl,0,1000,"")."\n"
      }
      $out.=$cl."\n"
    }
    return $out
  } elsif ($encode eq '8bit') {
    my $out=""; 
    for my $line (split(/\n/,$data)) {
      while (length($line) > 1000) {
        $out.=substr($line,0,1000,"")."\n"
      }
      $out.=$line."\n"
    }
    return $out
  }
  return $data
}

sub localip {
  my $socket = IO::Socket::INET->new(
    Proto       => 'udp',
    PeerAddr    => '198.41.0.4', # a.root-servers.net
    PeerPort    => '53', # DNS
  );
  if (!$socket) { return '0.0.0.0' }
  return $socket->sockhost;
}

# EOF gclient.pm (C) 2019 Chaosje, Domero
```

---

- `gparse.pm`:
```perl
#!/usr/bin/perl

#################################################################
#                                                               #
#    Generic Parsing v1.0.0                                     #
#                                                               #
#    (C) 2008 Gideon Dynamics, Groningen                        #
#    ALL RIGHTS RESERVERD                                       #
#                                                               #
#################################################################
#
#  Methods
#
#    obj(string):object  # str2boj alias; Parse String to Perl Object data
#    str(object):string  # obj2str alias; Parse Perl Object to String data
#
#  Usage:
#
#  my $d=gparse::str2obj($datastring);         # Create Object
#  print $d->{data}
#################################################################
package gparse;
use strict;
#use warnings;
1;
################################################################################
# Create Object-Data from String-Data
# gparse::str2obj($string):$obj;
sub obj { return str2obj(@_) }
sub str2obj { # $data:string, [from-file:debuginfo], [%{$var}:accessable data object in the string evaluation envirement]
  my $data=shift;
  my $file=shift;
  my %import=@_;
  my $var=\%import;
  my $obj=[]; eval("push \@{\$obj},".($data ? $data : 'undef').";");
  if($@) {
#    error::fatal(undef,"gparse::Str2Obj : $@ \nin ".($file ? "file: '$file'; ":"")."data:\n '$data'");
    return undef
  }
  return shift @{$obj}
}
################################################################################

################################################################################
# parse data TO String
# gparse::obj2str($obj):$string;
sub str { return obj2str(@_) }
sub obj2str { # $@%object:direct printable perl evaluation object string.
  my $obj=shift;
  my $lev=shift; if(defined $lev){ $lev>>=0 } else { $lev=0 }
  my $maxlev=shift; if(defined $maxlev){ $maxlev>>=0 } else { $maxlev=0 }
  my $noclass=shift; if(defined $noclass){ $noclass>>=0 } else { $noclass=0 }
  if(!defined $obj){ return 'undef' }
  my @r=();
  my $isarrayclass=(ref($obj) ne "ARRAY" && "$obj" =~ /^.+\=ARRAY\(.+\)$/ ? ref($obj):''); 
  my $ishashclass=(ref($obj) ne "HASH" && "$obj" =~ /^.+\=HASH\(.+\)$/ ? ref($obj):'');
#  if($ishashclass){ $obj->{__PACKAGE__}=ref($obj) }
  if(
    (!$noclass || (!$isarrayclass && !$ishashclass)) &&
    (!$maxlev || ($maxlev && $lev ne $maxlev))
  ){
    # Array || Package
    if(ref($obj) eq "ARRAY" || $isarrayclass){
      foreach my $a ( @{$obj} ){ push @r,obj2str($a,$lev+1,$maxlev,1) }
      return "[".join(",",@r)."]";
    }
    # Hash || Package
    elsif(ref($obj) eq "HASH" || ref($obj) eq "REF" || $ishashclass){
      foreach my $k ( sort { lc($a) cmp lc($b) } @{[keys %{$obj}]} ){ push @r,'"'.quotemeta($k).'"=>'.obj2str($obj->{$k},$lev+1,$maxlev,1) }
      return "{".(0+@r ? "\n".("  "x($lev+1)) . join(",\n".("  "x($lev+1)),@r) . "\n".("  "x($lev)):'')."}";
    }
    # Scaler Ref
    elsif(ref($obj) eq "SCALAR"){
      return obj2str(${$obj},$lev+1,$maxlev,1);
    }
    # Code Ref
    elsif(ref($obj) eq "CODE"){
    }
    # Global Ref
    elsif(ref($obj) eq "GLOB"){
    }
    # Integer
    elsif(defined $obj && $obj ne "" && int($obj) eq $obj){
      return $obj
    }
    # (Long)Real
    elsif(realv($obj)){
      return "$obj"
    }
  }
  # String
  my $string=quotemeta($obj);
  $string =~ s/\x{001B}/e/g;
  $string =~ s/\x{00}/00/g;
  $string =~ s/\x{1B}/esc/g;
  $string =~ s/\[([^m]+)m/[$1]m/g;
  $string =~ s/\\\n/\n/g;
  $string =~ s/\\\s/ /g;
  $string =~ s/\\\=/=/g;
  $string =~ s/\\\:/:/g;
  $string =~ s/\\\&/&/g;
  $string =~ s/\\\%/%/g;
  $string =~ s|\\\/|/|g;
  $string =~ s|\\\.|.|g;
  $string =~ s|\\\;|;|g;
  $string =~ s/\\\-/-/g; $string =~ s/\\\+/+/g;
  $string =~ s/\\\#/#/g;
  $string =~ s/\\\(/(/g; $string =~ s/\\\)/)/g;
  $string =~ s/\\\[/[/g; $string =~ s/\\\]/]/g;
  if($ishashclass){ $string =~ s/\(.+\)$// }
  return '"'.$string.'"'
}


################################################################################
# parse data TO PHP
sub php { return obj2php(@_) }
sub obj2php { # $@%object:direct printable perl evaluation object string.
  my $obj=shift;
  my $lev=shift>>0;
  my $maxlev=shift>>0;
  my $noclass=shift>>0;
  if(!defined $obj){ return 'undef' }
  my @r=();
  my $isarrayclass=(ref($obj) ne "ARRAY" && "$obj" =~ /^.+\=ARRAY\(.+\)$/ ? ref($obj):''); 
  my $ishashclass=(ref($obj) ne "HASH" && "$obj" =~ /^.+\=HASH\(.+\)$/ ? ref($obj):'');
#  if($ishashclass){ $obj->{__PACKAGE__}=ref($obj) }
  if(
    (!$noclass || (!$isarrayclass && !$ishashclass)) &&
    (!$maxlev || ($maxlev && $lev ne $maxlev))
  ){
    # Array || Package
    if(ref($obj) eq "ARRAY" || $isarrayclass){
      foreach my $a ( @{$obj} ){ push @r,obj2php($a,$lev+1,$maxlev,1) }
      return "Array(".join(",",@r).")";
    }
    # Hash || Package
    elsif(ref($obj) eq "HASH" || ref($obj) eq "REF" || $ishashclass){
      foreach my $k ( sort { lc($a) cmp lc($b) } @{[keys %{$obj}]} ){ push @r,'"'.quotemeta($k).'"=>'.obj2php($obj->{$k},$lev+1,$maxlev,1) }
      return "Array(".(0+@r ? "\n".("  "x($lev+1)) . join(",\n".("  "x($lev+1)),@r) . "\n".("  "x($lev)):'').")";
    }
    # Scaler Ref
    elsif(ref($obj) eq "SCALAR"){
      return obj2php(${$obj},$lev+1,$maxlev,1);
    }
    # Code Ref
    elsif(ref($obj) eq "CODE"){
    }
    # Global Ref
    elsif(ref($obj) eq "GLOB"){
    }
    # Integer
    elsif(defined $obj && $obj ne "" && int($obj) eq $obj){
      return $obj
    }
    # (Long)Real
    elsif(realv($obj)){
      return "$obj"
    }
  }
  # String
  my $string=quotemeta($obj);
  $string =~ s/\\\n/\n/g;
  $string =~ s/\\\s/ /g;
  $string =~ s/\\\=/=/g;
  $string =~ s/\\\:/:/g;
  $string =~ s/\\\&/&/g;
  $string =~ s/\\\%/%/g;
  $string =~ s|\\\/|/|g;
  $string =~ s|\\\.|.|g;
  $string =~ s|\\\;|;|g;
  $string =~ s/\\\-/-/g; $string =~ s/\\\+/+/g;
  $string =~ s/\\\#/#/g;
  $string =~ s/\\\(/(/g; $string =~ s/\\\)/)/g;
  $string =~ s/\\\[/[/g; $string =~ s/\\\]/]/g;
  if($ishashclass){ $string =~ s/\(.+\)$// }
  return '"'.$string.'"'
}


################################################################################
# parse data TO Javascript
# gparse::obj2str($obj):$string;
sub js { return obj2js(@_) }
################################################################################
sub obj2js {# $@%object:direct printable javascript evaluation object string.
  my $obj=shift;
  my $lev=shift>>0;
  my $maxlev=shift>>0;
  my $noclass=shift>>0;
  if(!defined $obj){ return 'undef' }
  my @r=();
  my $isarrayclass=(ref($obj) ne "ARRAY" && "$obj" =~ /^.+\=ARRAY\(.+\)$/ ? ref($obj):''); 
  my $ishashclass=(ref($obj) ne "HASH" && "$obj" =~ /^.+\=HASH\(.+\)$/ ? ref($obj):'');
#  if($ishashclass){ $obj->{__PACKAGE__}=ref($obj) }
  if(
    (!$noclass || (!$isarrayclass && !$ishashclass)) &&
    (!$maxlev || ($maxlev && $lev ne $maxlev))
  ){
    # Array || Package
    if(ref($obj) eq "ARRAY" || $isarrayclass){
      foreach my $a ( @{$obj} ){ push @r,obj2str($a,$lev+1,$maxlev,1) }
      return "[".join(",",@r)."]";
    }
    # Hash || Package
    elsif(ref($obj) eq "HASH" || ref($obj) eq "REF" || $ishashclass){
      foreach my $k ( sort { lc($a) cmp lc($b) } @{[keys %{$obj}]} ){ push @r,'"'.quotemeta($k).'":'.obj2str($obj->{$k},$lev+1,$maxlev,1) }
      return "{".(0+@r ? "\n".("  "x($lev+1)) . join(",\n".("  "x($lev+1)),@r) . "\n".("  "x($lev)):'')."}";
    }
    # Scaler Ref
    elsif(ref($obj) eq "SCALAR"){
      return obj2str(${$obj},$lev+1,$maxlev,1);
    }
    # Code Ref
    elsif(ref($obj) eq "CODE"){
    }
    # Global Ref
    elsif(ref($obj) eq "GLOB"){
    }
    # Integer
    elsif(defined $obj && $obj ne "" && int($obj) eq $obj){
      return $obj
    }
    # (Long)Real
    elsif(realv($obj)){
      return "$obj"
    }
  }
  # String
  my $string=quotemeta($obj);
  $string =~ s/\\\n/\n/g;
  $string =~ s/\\\s/ /g;
  $string =~ s/\\\=/=/g;
  $string =~ s/\\\:/:/g;
  $string =~ s/\\\&/&/g;
  $string =~ s/\\\%/%/g;
  $string =~ s|\\\/|/|g;
  $string =~ s|\\\.|.|g;
  $string =~ s|\\\;|;|g;
  $string =~ s/\\\-/-/g; $string =~ s/\\\+/+/g;
  $string =~ s/\\\#/#/g;
  $string =~ s/\\\(/(/g; $string =~ s/\\\)/)/g;
  $string =~ s/\\\[/[/g; $string =~ s/\\\]/]/g;
  if($ishashclass){ $string =~ s/\(.+\)$// }
  return '"'.$string.'"'
}
################################################################################
sub js2obj {
  my($r,$v)=@_;
  my $q='"';
  my $Q='_q_';
  $r =~ s/$q\:\s$q/$q: $Q/gs;
  $r =~ s/$q([^\"]+)$q\:/$Q$1$Q:/gsi;
  $r =~ s/$q\,(\s*)$Q/$Q,$1$Q/gs;
#  print $r."\n";
  $r =~ s/$q\}/$Q}/gs;
  $r =~ s/([^\\])$q/$1\\$q/gs;
  $r =~ s/([^\\])$q/$1\\$q/gs;
  $r =~ s/$Q/$q/gs;
  $r =~ s/$q\:/$q=>/gsi;
  if($v){ print $r."\n"; }
  eval("\$r=$r;");
  return $r
}
################################################################################

## Real Valid ? # -+0.9(e-+09) == 1
sub realv {
  my $r=shift;
  $r.='';
  if($r =~ /^([\-\+]{1}?[0-9\.]+)[e]{1}?([\-\+]{1}?[0-9\.]+?)$/i ){
    my ($e,$f,$b,@n)=($2,split(/\./,$1));
    if(0+@n){ return 0 };
    if($e){ return ( (int($f) eq $f) && (int($b) eq $b) && (int($e) eq $e) ) }
    return ( (int($f) eq $f) && (int($b) eq $b) )
  }
  return 0
}
################################################################################
```

---

- `gfio.pm`:
```perl
#!/usr/bin/perl

 #############################################################################
 #                                                                           #
 #   Eureka File System                                                      #
 #   (C) 2017 Domero, Groningen, NL                                          #
 #   ALL RIGHTS RESERVED                                                     #
 #                                                                           #
 #############################################################################

# Exported
#
# $handle=newfile(filename,content,[no_read])
#  * creates a file with content, and returns the handle for further processing.
# $handle=open(filename,[r|w|a])
#  * append will overrule write, use write or append to create
# $handle->close
#  * unlocks, flushes and closes a file
# $position=$handle->tell
#  * returns the current position to write to or read from in a file
# $handle->seek($position)
#  * jumps to position in a file, position may not be larger than filesize
# $length=$handle->filesize
#  * returns the length in bytes of a file.
# $handle->truncate(length)
#  * if the size of a file is larger than length, will truncate the file to length, and apply changes to size and position if necessary.
# $data=$handle->read(length,stopatend)
#  * returns length bytes read from a file.
# $datapointer=$handle->readptr(length)
#  * returns a SCALAR-reference to length bytes read from a file.
# $handle->write(data)
#  * writes data to a file. data may be a SCALAR-reference.
# $handle->insert(data,[append])
#  * inserts data into a file at the current position, and increases the filesize accordingly. data may be a SCALAR-reference. 
#  * if append is set, the data will be appended in stead of inserted.
# $handle->appenddata(data)
#  * Appends data to the end of the open file-handle (for closed files use append).
# $handle->extract(length)
#  * removes length bytes from a file at the current position and truncates the file. returns the extracted data.
# $handle->lock
#  * exclusively increases the lock on a file.
# $handle->unlock
#  * decreases a lock on a file, if no locks remain, will unlock the file. Always use the same number of locks and unlocks!
#
# closeall
#  * closes all cureently open files
# makedir(dirname,[mode])
#  * default mode = 0700 (rwx)
# create(filename,[content],[not_empty],[mode])
#  * creates a file with content. if not_empty is set, will not create empty files. default mode = 0600 (rw)
# changeowner(filename,user,group)
#  * changes ownership of a file
# content(filename,[offset],[length])
#  * returns the content of a file, or a part of it, without it staying opened.
# append(file,content)
#  * appends content to file.
# crapp(file,content,nonil,mode)
#  * if file exists, appends content to file, otherwise create file.
# copy(source_filename,destination_filename,[no_overwrite])
#  * copies a file, will not overwrite is flag is set.
# $handle=readfiles(directory,extlist,recursive,verbose)
#  * read all files in a directory. extlist may be "ext,ext,..", empty or '*'.
# $handle=readdirs(directory,recursive,verbose)
#  * reads a directory-tree.
# total=$handle->numfiles
#  * returns the number of files read by readfiles or readdirs.
# \%infohash=$handle->getfile(number)
#  * returns information on file number read by readfiles or readdirs, number must be between 1 and $handle->numfiles.
#    The list contains (hash): barename, ext, name, dir, fullname, level, mode, size, atime, mtime, ctime

package gfio;

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '1.12';
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(open close seek tell read write insert extract readlines filesize truncate create crapp newfile lock unlock locked changeowner content append copy makedir closeall readfiles readdirs numfiles getfile);

use Fcntl qw (:DEFAULT :flock);
use gerr qw(error);

my %OPENED=();

1;

sub open {
  my ($file,$mode) = @_;
  my $self = {}; bless $self;
  $self->{file}=$file;
  $self->{openmode}=$mode;
  $self->{read}=0; if (!defined $mode || ($mode =~ /r/i)) { $self->{read}=1 }
  $self->{write}=0; if (defined $mode && $mode =~ /w/i) { $self->{write}=1 }
  $self->{append}=0; if (defined $mode && $mode =~ /a/i) { $self->{append}=1 }
  if (!-e $file) {
    if (!$self->{write} && !$self->{append}) {
      error("GFIO.Open: File '$file' does not exist")
    } else {
      $self->makepath;
      if ($self->{read}) {
        sysopen($self->{handle},$file,O_CREAT | O_RDWR | O_BINARY)
      } else {
        sysopen($self->{handle},$file,O_CREAT | O_WRONLY | O_BINARY)
      }
    }
  } else {
    if (!-f $file) {
      if (-d $file) {
        error("GFIO.Open: Cannot overwrite directory '$file' as a file")
      } elsif (-s $file) {
        error("GFIO.Open: Cannot overwrite symlink '$file' as a file")       
      } else {
        error("GFIO.Open: Cannot overwrite '$file' as a file")
      }
    }
  }
  if ($self->{append}) {
    if ($self->{read}) {
      sysopen($self->{handle},$file,O_APPEND | O_RDWR  | O_BINARY) || error("GFIO.Open: Cannot open '$file' in mode 'ar': $!")
    } else {
      sysopen($self->{handle},$file,O_APPEND | O_WRONLY | O_BINARY) || error("GFIO.Open: Cannot open '$file' in mode 'a': $!")
    }
  } elsif ($self->{write}) {                                                                                      
    if ($self->{read}) {
      sysopen($self->{handle},$file,O_RDWR | O_BINARY) || error("GFIO.Open: Cannot open '$file' in mode 'rw': $!")
    } else {
      sysopen($self->{handle},$file,O_WRONLY | O_BINARY) || error("GFIO.Open: Cannot open '$file' in mode 'w': $!")
    }
  } else {
    sysopen($self->{handle},$file,O_RDONLY | O_BINARY) || error("GFIO.Open: Cannot open '$file' in mode 'r': $!")
  }
  my @st=stat($self->{file}); $self->{size}=$st[7];
  if ($self->{append}) {
    $self->{position}=$self->{size}
  } else {
    $self->{position}=0
  }
  $self->{opened}=1;
  $self->{locked}=0;
  $OPENED{$file}=$self;
  return $self    
}

sub closeall {
  foreach my $file (keys %OPENED) { $OPENED{$file}->close }
}

sub makepath {
  my ($self) = @_;
  my @dir=split(/\//,$self->{file}); pop @dir;
  my $path="";
  foreach my $d (@dir) {
    $path.=$d;
    if ($path ne "" && $path ne '.' && $path ne '..' && !-e $path) {
      mkdir($path,0700)
    }
    $path.="/"
  }
}

sub filesize {
  my ($self) = @_; return $self->{size}
}
 
sub makedir {
  my ($newdir,$mode) = @_;
  if (!$newdir) { return }
  if(!$mode){ $mode=0700 }
  my @dir=split(/\//,$newdir);
  my $path="";
  foreach my $d (@dir) {
    $path.=$d;
    if ($path && ($path ne '.') && ($path ne '..') && (!-e $path)) {
      mkdir($path,$mode)
    }
    $path.="/"
  }
}

sub create {
  # WILL OVERWRITE!!!
  my ($filename,$content,$nonil,$mode) = @_;
  if (!$filename) { return }
  if ($nonil) {
    if(!defined $content) { return }
    if (ref($content) eq 'SCALAR') {
      if (length(${$content})==0) { return }
    } elsif (length($content)==0) { return }
  }
  if (-e $filename && -f $filename) {
    unlink($filename)
  } 
  my $fh=gfio::open($filename,'w');
  if ((defined $content) && (length($content))) {
    if (ref($content) eq 'SCALAR') { $fh->write($content) } else { $fh->write(\$content) }
  }
  $fh->close;
  if ($mode) { chmod $mode,$filename }
}

sub newfile {
  my ($filename,$content,$noread) = @_;
  if (!$filename) { return }
  my $mode='rw'; if ($noread) { $mode='w' }
  my $fh=gfio::open($filename,$mode);
  if (ref($content) eq 'SCALAR') { $fh->write($content) } else { $fh->write(\$content) }
  return $fh
}

sub append {
  my ($filename,$content) = @_;
  if (!-e $filename) {
    error("GFIO.Append: File '$filename' does not exist")
  }
  my $fh=gfio::open($filename,'a'); 
  if (ref($content) eq 'SCALAR') { $fh->write($content) } else { $fh->write(\$content) }
  $fh->close
}

sub crapp {
  if (!-e $_[0]) { gfio::create(@_) } else { gfio::append(@_) }
}

sub content {
  my ($filename,$offset,$length) = @_;
  if (!$filename) {
    error("GFIO.Content: No filename given")    
  }
  if (!-e $filename) {
    error("GFIO.Content: File '$filename' does not exist")
  }
  if (!-f $filename) {
    error("GFIO.Content: '$filename' is not a plain file")
  }
  my $fh=gfio::open($filename,'r');
  if (!defined $offset) { $offset=0 }
  if (!defined $length) { $length=$fh->{size} }
  if ($offset>$fh->{size}) {
    error("GFIO.Content: Read beyond boundries of '$filename', offset=$offset, size=$fh->{size}")
  }
  if ($offset+$length>$fh->{size}) {
    error("GFIO.Content: Read beyond boundries of '$filename', offset=$offset, reading $length bytes, size=$fh->{size}")
  }
  $fh->seek($offset);
  my $txt=$fh->readptr($length); $fh->close;
  return ${$txt}
}

sub changeowner {
  if ($^O =~ /win/i) { return }
  my ($filename,$user,$group) = @_;
  my ($login,$pass,$uid,$gid) = getpwnam($user);
  my ($glogin,$gpass,$guid,$ggid) = getpwnam($group);
  if ($uid && $ggid && $filename) {
    chown $uid, $ggid, $filename
  }
}

sub copy {
  my ($src,$des,$nooverwrite)=@_;
  if (!$src || !$des) { return }
  if (!-e $src) {
    error("GFIO.Copy: Source file '$src' does not exist")
  }
  if (!-f $src) {
    error("GFIO.Copy: Source '$src' is not a file!")
  }
  if (!$nooverwrite || !-e $des) {
    if (-e $des) { unlink $des }
    my $s=gfio::open($src,'r'); my $d=gfio::open($des,'w');
    my $eof=0; my $b=1<<20; my $p=0; my $l=$s->{size};
    while(!$eof){
      if($p+$b>$l){ $b=$l-$p }
      $d->write($s->readptr($b));
      $p+=$b; if($p>=$l){ $eof=1 }
    }
    $s->close; $d->close;
  }
}

sub close {
  my ($self) = @_; 
  if ($self->{opened}) {
    my $oldh = select $self->{handle}; $| = 1; select($oldh); # flush
    while ($self->{locked}) { $self->unlock }
    close($self->{handle}); $self->{opened}=0;
    delete $OPENED{$self->{file}}
  }
}

sub tell {
  my ($self) = @_; return $self->{position}
}

sub seek {
  my ($self,$pos) = @_;
  if ($pos<0) {
    error("GFIO.Seek: Trying to seek before beginning of file '$self->{file}'","Seek=$pos EOF=$self->{size}")
  }  
  if ($pos>$self->{size}) {
    error("GFIO.Seek: Seek beyond end of file '$self->{file}'","Seek=$pos EOF=$self->{size}")
  }
  sysseek($self->{handle},$pos,0); $self->{position}=$pos;
  return $self
}

sub read {
  my ($self,$len,$stopatend) = @_;
  if (!$len) { return "" }
  if (!$self->{opened}) { error("GFIO.Read: File '$self->{file}' is closed") }
  if (!$self->{read}) { error("GFIO.Read: File '$self->{file}' is read-protected") }
  if ($self->{position}+$len>$self->{size}) {
    if ($self->{position}>$self->{size}) {
      error("GFIO.Read: Trying to read beyond the end of file '$self->{file}', position=$self->{position} len=$len size=$self->{size}")
    } elsif ($stopatend) {
      my $mlen=$self->{size}-$self->{position};
      if ($len>$mlen) { $len=$mlen }
    } else {
      error("GFIO.Read: Trying to read beyond the end of file '$self->{file}', position=$self->{position} len=$len size=$self->{size}")
    }
  }
  sysseek($self->{handle},$self->{position},0) || error("GFIO.Read: Error seeking in file '$self->{file}' pos=$self->{position}: $!");
  my $data;
  if ($len<0) {
    error("GFIO.Read: Neagtive length '$len' reading on position '$self->{position}' in file '$self->{file}', size=$self->{size}")
  }
  sysread($self->{handle},$data,$len) || error("GFIO.Read: Error reading from file '$self->{file}', len=$len: $!");
  $self->{position}+=$len;
  return $data;
}

sub readptr {
  my ($self,$len,$errormode) = @_; 
  if (!$len) { my $dat=""; return \$dat }
  if (!$self->{opened}) { error("GFIO.ReadPtr: File '$self->{file}' is closed") }
  if (!$self->{read}) { error("GFIO.ReadPtr: File '$self->{file}' is read-protected") }
  if ($self->{position}>$self->{size}) {
    $self->{position}=$self->{size}
  }
  if ($self->{position}+$len>$self->{size}) {
    if ($errormode) {
      error("GFIO.ReadPtr: Trying to read beyong boundries of file '$self->{file}', position=$self->{position} len=$len size=$self->{size}")
    } else {
      $len=$self->{size}-$self->{position};
    }  
  }
  sysseek($self->{handle},$self->{position},0) || error("GFIO.ReadPtr: Error seeking in file '$self->{file}' pos=$self->{position}: $!");
  my $data;
  sysread($self->{handle},$data,$len) || error("GFIO.ReadPtr: Error reading from file '$self->{file}', len=$len: $!");
  $self->{position}+=$len;
  return \$data;
}

sub readlines {
  my ($filename) = @_;
  if (!$filename) {
    error("GFIO.Content: No filename given")    
  }
  if (!-e $filename) {
    error("GFIO.Content: File '$filename' does not exist")
  }
  if (!-f $filename) {
    error("GFIO.Content: '$filename' is not a plain file")
  }
  my $size=0; my $txt;
  my $fh=gfio::open($filename,'r'); $size=$fh->{size}; $txt=$fh->read($size); $fh->close;
  my $lines=[]; my $i=0; my $curline="";
  while ($i<$size) {
    my $c=substr($txt,$i,1); my $cc=ord($c);
    if ($cc!=13) {
      if ($cc==10) {
        push @{$lines},$curline; $curline=""
      } else {
        $curline.=$c
      }
    }
    $i++
  }
  return $lines
}

sub write {
  my ($self,$data,$nonil) = @_;
  if (ref($data) eq 'SCALAR') { $data=${$data} }
  if (!defined $data) { 
    if ($nonil) { error("GFIO.Write: Trying to write empty data, while prohibited") }
    return $self
  }
  if (!$self->{opened}) { error("GFIO.Write: File '$self->{file}' is closed") }
  if (!$self->{write} && !$self->{append}) { error("GFIO.Write: File '$self->{file}' is write-protected") }
  sysseek($self->{handle},$self->{position},0) || error("GFIO.Write: Error seeking in file '$self->{file}' pos=$self->{position}: $!");
  syswrite($self->{handle},$data) || error("GFIO.Write: Error writing to file '$self->{file}', len=".length($data).": $!");
  $self->{position}+=length($data);
  if ($self->{position}>$self->{size}) { $self->{size}=$self->{position} }
  return $self
}


sub truncate {
  my ($self,$length) = @_;
  if ($self->{size}<=$length) { return }
  truncate($self->{handle},$length);
  if ($self->{position}>$length) { $self->{position}=$length }
  $self->{size}=$length;
  return $self
}

sub lock {
  my ($self) = @_;
  if (!$self->{locked}) {
    flock($self->{handle},LOCK_EX)
  }  
  $self->{locked}++;
  return $self
}

sub unlock {
  my ($self) = @_;
  if ($self->{locked}) {
    $self->{locked}--;
    if (!$self->{locked}) {
      flock($self->{handle},LOCK_UN)
    }
  } else {
    error("GFIO.Unlock: File '$self->{file}' was not locked!")
  }
  return $self
}

sub locked {
  my ($self) = @_;
  return $self->{locked}
}

sub insert {
  my ($self,$content,$append) = @_;
  if ($append) { $self->seek($self->{size}) }
  my $start=$self->{position};
  if (!$self->{write} && !$self->{append}) { error("GFIO.Insert: File '$self->{file}' is write-protected") }
  my $movelen=$self->{size}-$start;
  my $dat=$self->readptr($movelen);
  $self->seek($start); $self->write($content); 
  my $pos=$self->tell; $self->write($dat); $self->seek($pos)
}

sub appenddata {
  my ($self,$content) = @_;
  if (!$self->{write} && !$self->{append}) { error("GFIO.Appenddata: File '$self->{file}' is write-protected") }
  $self->seek($self->{size});
  $self->write($content)
}

sub extract {
  my ($self,$len) = @_;
  my $start=$self->{position};
  my $pos=$self->{position}+$len;
  my $dat;
  if ($pos>$self->{size}) {
    $dat=$self->readptr($self->{size}-$start);
    $self->truncate($start)
  } else {
    $self->seek($pos); $dat=$self->readptr($self->{size}-$pos);
    $self->seek($start); $self->write($dat); $self->truncate($self->{size}-$pos); $self->seek($start)
  }
  return ${$dat}
}

############################## DIRECTORY LISTINGS #####################################

sub verbosefile {
  my ($self,$txt) = @_;
  print "\rReading: ";
  if (length($txt)>70) {
    print "...".substr($txt,length($txt)-67)
  } else {
    print $txt; print " "x(70-length($txt))
  }
}

sub doreadfiles {
  my ($self,$dir,$verbose,$num) = @_;
  my $fl; my $handle;
  opendir($handle,$dir) or error("GFIO.Readfiles: Error opening directory '$dir': $!");
  my $slash=(substr($dir,length($dir)-1,1) eq '/');
  do {
    my $ff;
    $fl=readdir($handle);
    if ($fl && ($fl ne ".") && ($fl ne '..')) {
      my @ss=split(/\//,$fl); my $fname=pop @ss;
      if ((lc($fname) ne 'system volume information') && (lc($fname) ne 'recycler')) {
        my @ps=split(/\./,$fname); my $fext=pop @ps; my $fsname;
        if ($fname =~ /\./) { $fsname=join(".",@ps) } else { $fsname=$fext; $fext="" }
        if ($slash || !$dir) { $ff=$dir.$fname } else { $ff=$dir."/".$fname }
        if ((!-l $ff) && (-r $ff)) {
          if (-d $ff) {
            if ($self->{recursive}) {
              if ($verbose) { $self->verbosefile("[$ff]") }
              $self->doreadfiles($ff,$verbose,$num)
            }
          } elsif ($self->{allext} || $self->{extlist}{lc($fext)}) {
            if ($verbose) { $self->verbosefile("${$num}. $fname") }
            ${$num}++;
            my @data=($fsname,$fext,$fname,$dir,$ff,'file');
            push @{$self->{list}},\@data;
          }
        }
      }
    }
  } until (!$fl);
  closedir($handle)
}

sub readfiles {
# INPUT    dir,"ext,ext,..",subdirs also (recursively), verbose (if 1 prints info to the <STDOUT>)
# Usage: $files->{list}[num][ 0=name, 1=extension, 2=name+ext, 3=directory, 4=dir+name+ext ]
  my ($dir,$extlist,$subdirs,$verbose) = @_;
  $dir =~ s/\\/\//g;
  my $self={}; bless($self);
  $self->{dir}=$dir; $self->{exist}=1;
  $self->{list}=[]; $self->{recursive}=$subdirs;
  if (defined($extlist)) {
    $extlist =~ s/ //g; $self->{extlist}={};
    foreach my $ext (split(/\,/,$extlist)) {
      $self->{extlist}{lc($ext)}=1
    }
  }  
  if (!-e $dir) {
    $self->{exist}=0; return $self
  }
  $self->{allext}=(!defined($extlist) || ($extlist eq '*') || !$extlist);
  my $num=1;
  $self->doreadfiles($dir,$verbose,\$num);
  if ($verbose) { print "\r"; print " "x79; print "\r" }
  return $self
}

sub doreaddirs {
  my ($self,$dir,$lev,$verbose) = @_;
  my $fl; my $handle;
  opendir($handle,$dir) or error("Error opening directory '$dir': $!");
  my $slash=(substr($dir,length($dir)-1,1) eq '/');
  do {
    my $ff;
    $fl=readdir($handle);
    if ($fl && ($fl ne ".") && ($fl ne '..')) {
      my @ss=split(/\//,$fl); my $fname=pop @ss;
      if ((lc($fname) ne 'system volume information') && (lc($fname) ne 'recycler')) {
        my @ps=split(/\./,$fname); my $fext=pop @ps; my $fsname;
        if ($fname =~ /\./) { $fsname=join(".",@ps) } else { $fsname=$fext; $fext="" }
        if ($slash || !$dir) { $ff=$dir.$fname } else { $ff=$dir."/".$fname }
        if ((!-l $ff) && (-d $ff) && (-r $ff)) {
          if ($verbose) { $self->verbosefile("[$ff]") }
          my @data=($fsname,$fext,$fname,$dir,$ff,$lev);
          push @{$self->{list}},\@data;
          if ($self->{recursive}) {
            $self->doreaddirs($ff,$lev+1)
          }
        }
      }
    }
  } until (!$fl);
  closedir($handle)
}

sub readdirs {
# INPUT    dir,subdirs also (recursively)
# Only read directories
  my ($dir,$subdirs,$verbose) = @_;
  $dir =~ s/\\/\//g;
  my $self={}; bless($self);
  $self->{dir}=$dir; $self->{exist}=1;
  $self->{list}=[]; $self->{recursive}=$subdirs;
  if (!-e $dir) {
    $self->{exist}=0; return $self
  }
  $self->doreaddirs($dir,0,$verbose);
  if ($verbose) { print "\r"; print " "x79; print "\r" }
  return $self
}

sub numfiles {
  my ($self) = @_;
  return 0+@{$self->{list}}
}

sub getfile {
  my ($self,$num) = @_;
  if (!$num) { $num=0 }
  if (($num<1) || ($num>$self->numfiles)) {
    error("GFIO.GetFile: File '$num' is invalid (must be between 1 and ".$self->numfiles.", reading '".$self->{dir}."')")
  }
  my $fi=$self->{list}[$num-1];
  my @stat=stat($fi->[4]) || (0)x11;
  my $info={
    barename => $fi->[0],
    ext => $fi->[1],
    name => $fi->[2],
    dir => $fi->[3],
    fullname => $fi->[4],
    level => $fi->[5],
    mode => $stat[2],
    size => $stat[7],
    atime => $stat[8],
    mtime => $stat[9],
    ctime => $stat[10]
  };
  $info->{isdir}=0; if ($fi->[5] =~ /[0-9]/) { $info->{isdir}=1 }
  return $info
}

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

# Flag    Description
#
# O_RDONLY   Read only.
# O_WRONLY   Write only.
# O_RDWR   Read and write.
# O_CREAT  Create the file if it doesn.t already exist.
# O_EXCL   Fail if the file already exists.
# O_APPEND   Append to an existing file.
# O_TRUNC   Truncate the file before opening.
# O_NONBLOCK   Non-blocking mode.
# O_NDELAY   Equivalent of O_NONBLOCK.
# O_EXLOCK   Lock using flock and LOCK_EX.
# O_SHLOCK   Lock using flock and LOCK_SH.
# O_DIRECTOPRY   Fail if the file is not a directory.
# O_NOFOLLOW   Fail if the last path component is a symbolic link.
# O_BINARY   Open in binary mode (implies a call to binmode).
# O_LARGEFILE   Open with large (>2GB) file support.
# O_SYNC   Write data physically to the disk, instead of write buffer.
# O_NOCTTY   Don't make the terminal file being opened the processescontrolling terminal, even if you don.t have one yet.

# EOF gfio.pm
```

---

- `gerr.pm`:
```perl
#!/usr/bin/perl

 #############################################################################
 #                                                                           #
 #   Eureka Error System v1.1.2                                              #
 #   (C) 2020 Domero, Groningen, NL                                          #
 #   ALL RIGHTS RESERVED                                                     #
 #                                                                           #
 #############################################################################

package gerr;

use strict;
use warnings; no warnings qw<uninitialized>;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use utf8;
use gterm::cntrl qw(tc size cols rows pr prat);

$VERSION     = '1.13';
@ISA         = qw(Exporter);
@EXPORT      = qw(error);
@EXPORT_OK   = qw(trace);

1;

sub error {
    my @msg=@_;
    my $return = 0;
    my $reset = 0;
    my $type = "FATAL ERROR";
    my $size = gterm::cntrl::cols()-2;
    my $trace = 2;
    my @lines;
    while ($#msg > -1) {
        if (!defined $msg[0]) { shift(@msg) }
        elsif ($msg[0] =~ /^return\=(.+)$/gs) { $return=$1; shift(@msg) }
        elsif ($msg[0] =~ /^reset\=(.+)$/gs) { $reset=$1; shift(@msg) }
        elsif ($msg[0] =~ /^type\=(.+)$/gs)   { $type=$1; shift(@msg) }
        elsif ($msg[0] =~ /^size\=(.+)$/gs)   { $size=$1; shift(@msg) }
        elsif ($msg[0] =~ /^trace\=(.+)$/gs)   { $trace=$1; shift(@msg) }
        else { push @lines, split(/\n/,shift(@msg)) }
    }
    $type=" $type ";
    my $tsize=length("$type");
    push @lines,"";
    my $ls=($size>>1)-($tsize>>1);
    my $rs=$size-($size>>1)-($tsize>>1)-1;
    my $tit= " ".("#" x $ls) . $type . ("#"x $rs)."\n";
    my $str= "\n\n";
    foreach my $line (@lines) {
        while (length($line)>0) {
            $str .= " # ";
            if (length($line)>$size) {
                $str .= substr($line,0,$size-6)."..." . " #\n";
                $line = "...".substr($line,$size-6)
            } else {
                $str .= $line . (($size-length($line)-3) > 0 ? (" "x($size-length($line)-3)):'') . " #\n";
                $line = ""
            }
        }
    }
    $str = ($reset ? gterm::cntrl::tc('reset_terminal'):"")."\n".gterm::cntrl::tc('reset') . $tit . trace($trace) . $tit . $str . $tit;
    if (!$return) { 
        $|=1;
        gterm::cntrl::pr($str);
        exit 1
    }
    return $str
}

sub trace {
    my $i=$_[0]||1;
    my @out=();
    while (($i>0) && ($i<20)) {
        my ($package,$filename,$line,$subroutine,$hasargs,$wantarray,$evaltext,$is_require,$hints,$bitmask,$hinthash)=caller($i);
        if (!$package) { $i=0 }
        else { push @out, [$line,"$package($filename)","Calling $subroutine".($hasargs ? "@DB::args":""),($subroutine eq '(eval)' && $evaltext ? "[$evaltext]":"")]; $i++ }
    }
    @out=reverse @out;
    if ($#out > -1) {
        for my $i (0..$#out) {
            my $dept="# ".(" " x $i).($i>0?"╰[":"┈[");
            my ($ln,$pk,$cl,$ev)=@{$out[$i]};
            my $ll=(60-length($dept.$cl));
            my $rr=(6-length($ln));
            $out[$i] = "$dept $cl".(" " x ( $ll>0 ? $ll : 0 ))."Line".(" " x ( $rr > 0 ? $rr : 0 ))."$ln : $pk".($ev ? "\n$ev":"");
        }
    }
    return join("\n",@out)."\n"
}

# EOF gerr.pm (C) 2020 Domero
```

