#!/usr/bin/perl -T -w
#
#   Bright Noise/Console
#
#   Version 0.5
#
#   Copyright 2002 by Me. <deekoo@tentacle.net>
#
#   Dedicated to Admiral John Poindexter
#   (Yes, the Iran/Contra/IAO guy.)
#   Because the Eye in the Pyramid winked
#   And It escaped from the Pentagon
#   
#   Licensed under the Surveillance Obstruction License:
#   
#   Using this program after reading the source code obligates you to send
#   the program's Listed Authors a copy of any information pertaining to the
#   Listed Authors in any databases that you have access to and have reason
#   to believe that the Listed Authors do not have access to.  This includes
#   government, corporate, or private databases.  If you do not send the
#   information, you are not permitted to use this program.
#
#   In the event that any part of this license is not considered enforceable
#   upon you, you may not use this program.
#
#   Where the information on the Listed Authors is logically separate, only
#   the information pertaining to each Listed Author should be sent to that
#   Listed Author.
#
#   You are considered to have access to said information if it is possible
#   for you to obtain it, irrespective of whether your organizational policies
#   permit you to obtain it or redistribute it.
#
#   Feel free to modify and redistribute, but you cannot change the license.
#   A person who modifies this program must notate the modification, and may
#   add themselves to the Listed Authors List if they so wish.
#
#   Any database where a fee is required to access said database or records
#   therein is to be considered not accessible to the Listed Authors.
#
#   The Listed Authors are:
#   deekoo@tentacle.net (aka Deekoo L., Nathaniel Bray) - initial code.
#
# CONFIGURATION

# Fontdrift is whether or not to modify the console font.
$FONTDRIFT = 1;

# Randomfonts: If true, random source fonts will be used if drifting
# doesn't work.
$RANDOMFONTS = 1;

# Max lag between font changes for random-font mode.
$FONTLAG = 3;

# Fontresetodds is the probability that the entire font will be reset to
# undrifted mode.
$FONTRESETODDS = 0.001;

# Charresetodds is the probability that an individual character will be reset
# to undrifted mode.
$CHARRESETODDS = 0.09;

# End config.

&parse_args();

use Term::ReadKey;
use POSIX ":sys_wait_h";
use Expect;
$Expect::Multiline_Matching = 0;
ReadMode 5;
$ENV{PATH}='/bin:/usr/bin:/usr/local/bin';
select(STDOUT);$|=1;

if ($FONTDRIFT) {
  if ($fonttwiddler=fork()==0) {
    if (!&load_sbf()) {
      print STDERR "Can't load an SBF.  Falling back to random fonts.\n";
      &random_fonts();
    }
    &twiddle_font();
  }
} elsif ($RANDOMFONTS) {
  if ($fonttwiddler=fork()==0) {
    &random_fonts();
  }
}

$exp = new Expect;
if ($] >= 5.008) {
  $exp->raw_pty(1);
  $shell = $exp->spawn('/bin/sh','-i');
} else {
  $shell = Expect->spawn('/bin/sh','-i');
}
#$shell->stty(qw(raw -echo));
$shell->stty('sane');
$shell->send("stty sane\n"); #echo onlcr\n");
$shell->log_stdout(0);
my $rfds = '';
if ($shell->exp_pty_handle() =~/([0-9]+)/) {
  $shellhandle = $1;
  vec($rfds,$1,1) = 1;
} else {
  die "Bad shellhandle.\n",$shell->pty_handle();
}
vec($rfds,0,1) = 1;
$lastmatch = '';
while (1) {
  $numread = select($read = $rfds, undef, $errs=$rfds, 0.4);
  if (vec($read,0,1)) {
    my $ch = ReadKey(-1);
    my $line;
    while (defined($ch)) {
      $line .= $ch;
      $ch = ReadKey(-1);
    }
    if (defined($line)) {
      $shell->send($line);
    }
  }
  if (vec($read,$shellhandle,1)) {
    if ($shell->expect(0, '-re', '.+')) {
      $lastmatch = $shell->exp_match();
      if ($lastmatch=~/^(.*?)([\x1b\x9b].*?)$/s) {
        print $1;
        my $suf = $2;
        &cycle();
        print $suf;
      } else {
        print $lastmatch;
      }
      $after = $shell->clear_accum();
      if (length($after)) {
        print $after;
      }
    }
  }
  if (vec($errs,$shellhandle,1)) {
    ReadMode(0);
    kill('TERM',$fonttwiddler);
    die "Shell err.\n";
  }
  waitpid(-1,&WNOHANG);
  if ($numread==0) {
    if (!kill(0,$shell->exp_pid())) {
      kill ('TERM', $fonttwiddler);
      die "Shell died.\n";
    }
  }
  if ($lastmatch!~/[\x1b\x9b]/) {
    &cycle();
  }
}
exit(0);

sub slide()
{
  my $c = 0;
  while ($c<16) {
    ${$_[0]}[$c] += int(rand(32))-16;
    if (${$_[0]}[$c]<0) {
      ${$_[0]}[$c] = 0;
    } elsif (${$_[0]}[$c]>255) {
      ${$_[0]}[$c] = 255;
    }
    $c++;
  }
}

sub totalize($)
{
  return int($reds[$_[0]]/8) .'.'. int($greens[$_[0]]/8).'.'.($blues[$_[0]]/8);
}

sub randomize()
{
  $reds[$_[0]] = int(rand(256));
  $blues[$_[0]] = int(rand(256));
  $greens[$_[0]] = int(rand(256));
}

sub differentiate()
{
  my $c = 0;
  my %totals;
  my @redo;
  while ($c<16) {
    my $tot;
    $tot = &totalize($c);
    if (exists($totals{$tot})) {
      push @redo, $c;
    }
    $totals{$tot} = $c;
    $c++;
  }
  for $c (@redo) {
    &randomize($c);
    if (exists($totals{&totalize($c)})) {
      &randomize($c);
      if (exists($totals{&totalize($c)})) {
        &randomize($c);
      }
    }
    $totals{&totalize($c)}=$c;
  }
}

sub set_palette()
{
  my $c=0;
  while ($c<16) {
    printf "\x1b]P%x%02x%02x%02x", $c, $reds[$c], $blues[$c], $greens[$c];
    $c++;
  }
}

sub cycle()
{
  &slide(\@reds);
  &slide(\@greens);
  &slide(\@blues);
  &differentiate();
  &set_palette();
}

sub drift_char($)
{
  my $off = int(rand(length($_[0])));
  if (substr($_[0],$off,1) eq '.') {
    substr($_[0],$off,1) = '0';
  } elsif (substr($_[0],$off,1) eq '0') {
    substr($_[0],$off,1) = '.';
  }
  return $_[0];
}

sub drift_sbf2()
{
  my $x=0;
  while ($x<=$#sbf2_data) {
    if (rand(1)<$CHARRESETODDS) {
      $sbf2_data[$x] = $sbf_data[$x];
    } else {
      $sbf2_data[$x]=drift_char($sbf2_data[$x]);
    }
    $x++;
  }
}

sub twiddle_font()
{
  while(1) {
    if (rand(1)<$FONTRESETODDS) {
      @sbf2_data = @sbf_data;
    } else {
      drift_sbf2();
    }
    open(FILE,">$FONTDIR/drifting.sbf") or die "Closing.\n";
    my $x = 0;
    while ($x<=$#sbf2_data) {
      print FILE $sbf_numbers[$x],$sbf2_data[$x];
      $x++;
    }
    close(FILE);
    system("sbf2psf", "$FONTDIR/drifting.sbf", "$FONTDIR/drifted.psf");
    system("consolechars -f $FONTDIR/drifted.psf");
  }
}

sub delete_fontdir()
{
  if (defined($FONTDIR)) {
    unlink("$FONTDIR/orig.sbf");
    unlink("$FONTDIR/orig.psf");
    unlink("$FONTDIR/drifting.sbf");
    unlink("$FONTDIR/drifted.psf");
    rmdir($FONTDIR) or print STDERR "Unable to remove $FONTDIR\n";
  }
}

sub prepare_fontdir()
{
  if (exists($ENV{TEMPDIR})) {
    $FONTDIR = $ENV{TEMPDIR};
  } else {
    $FONTDIR = '/tmp';
  }
  $FONTDIR .= "/brightnoise-$$";
  mkdir($FONTDIR,0700);
  if (-d $FONTDIR) {
    chmod(0700,$FONTDIR) or die "Error chmodding $FONTDIR\n";
  } else {
    die "Unable to create $FONTDIR\n";
  }
  unlink("$FONTDIR/drifted.psf");
  unlink("$FONTDIR/drifting.sbf");
  unlink("$FONTDIR/orig.sbf");
  unlink("$FONTDIR/orig.psf");
  $SIG{__DIE__} = sub
    {
      &delete_fontdir();
      print STDERR @_;
      ReadMode 0;
      exit(1);
    };
  $SIG{'TERM'} = sub {
    &delete_fontdir();
    exit(1);
  };
}

sub determine_base_sbf()
{
  if (defined($BASEPSF)) {
    if ($BASEPSF=~/\.gz$/s) {
      my $psf = `zcat $BASEPSF`;
      local *FILE;
      open(FILE,">$FONTDIR/orig.psf") or die "Cannot write $FONTDIR/orig.psf\n";
      binmode(FILE);
      print FILE $psf;
      close(FILE);
      $BASEPSF = "$FONTDIR/orig.psf";
    }
    system('psf2sbf', $BASEPSF, "$FONTDIR/orig.sbf");
  } else {
    system('consolechars', '-d');
    system('consolechars', "--old-font-psf-with-sfm=$FONTDIR/orig.psf");
    system('psf2sbf', "$FONTDIR/orig.psf", "$FONTDIR/orig.sbf");
  }
  if ($? != -1) {
    $BASEFONT="$FONTDIR/orig.sbf";
  } else {
    die "Unable to produce base SBF font.  Not altering font.\n";
  }
}
  
sub load_sbf()
{
  &prepare_fontdir();
  if (!defined($BASEFONT)) {
    &determine_base_sbf();
  }
  if (!defined($BASEFONT)) {
    return 0;
  }
  open(FILE,"<$BASEFONT") or return 0;
  my @file = <FILE>;
  close(FILE);
  my $line;
  my $value;
  my $key = '';
  my $data = 0;
  my $num = 0;
  for $line (@file) {
    if ($line=~/\[/) {
      if ($data) {
        $data=0;
        $num++;
        $sbf_numbers[$num] = '';
      }
      $sbf_numbers[$num] .= $line;
    } else {
      $data=1;
      $sbf_data[$num] .= $line;
    }
  }
  @sbf2_data = @sbf_data;
  close(FILE);
  return 1;
}

sub random_fonts()
{
  if ($RANDOMFONTS) {
    my @dir = slurp_fonts('/usr/share/consolefonts');
    while(1) {
      sleep(rand($FONTLAG)+0.2);
      my $font = $dir[int(rand($#dir+1))];
      system('consolechars', '-f', $font);
    }
  } else {
    print STDERR "Random fonts disabled; not using them.\n";
  }
}

sub slurp_fonts()
{
  local *DIR;
  opendir(DIR,$_[0]) or
    die "Cannot opendir $_[0]\n";
  my @dir = readdir(DIR);
  closedir(DIR);
  my $f;
  my @ret;
  if (!defined($FONTHEIGHT)) {
    $FONTHEIGHT='16';
  }
  for $f (@dir) {
    if ((-f "$_[0]/$f") && ($f=~/$FONTHEIGHT/) && ($f=~/\.psf(|\.gz)$/s)) {
      push(@ret,"$_[0]/$f");
    }
  }
  return @ret;
}

sub parse_args()
{
  my @args = @ARGV;
  while(@args) {
    my $arg = shift(@args);
    if ($arg =~/^--charresetodds=([0-9\.]+)$/s) {
      $CHARRESETODDS = $1;
    } elsif ($arg =~/^--font=(.*?)$/s) {
      $BASEFONT = $1;
      if ($BASEFONT=~/\.psf(|\.gz)$/s) {
        $BASEPSF = $BASEFONT;
        undef($BASEFONT);
      }
    } elsif ($arg =~/^--fontheight=([0-9]+)$/s) {
      $FONTHEIGHT = $1;
    } elsif ($arg =~/^--fontresetodds=([0-9\.]+)$/s) {
      $FONTRESETODDS = $1;
    } elsif ($arg =~/^--nofontdrift$/s) {
      $FONTDRIFT = 0;
    } elsif ($arg eq '--norandomfonts') {
      $RANDOMFONTS=0;
    } else {
      if ($arg ne '--help') {
        print STDERR "Invalid arg $arg\n";
      }
      print STDERR "Usage:
brightnoise-console [options]

Valid options:
--nofontdrift: Disable console font changing.
--norandomfonts: Don't use random fonts, either.
--font=[file]: Path to SBF or PSF font.
--fontheight=[number]: Height (in pixels) of allowed source fonts.  This will
    be used if using random fonts instead of drifting.
--fontresetodds=<float>: Probability that the font will be reset when changing
    the console font.
--charresetodds=<float>: Probability that an individual character will be reset
    when changing the console font.
    
    All probabilities are floating-point numbers between 0 and 1.\n";
      exit(0);
    }
  }
}