#!/usr/bin/sperl
#
# -*- perl -*-
#
# piep - a small script to provide a simple way
# to chat on one machine using a named pipe.
# it needs to be run as one user, say nobody,
# 'cause it sends a SIGUSR1 to the partners
# pid, which is normally not allowed if the
# process runs under another uid.
#
# CopyLeft (c) 1999-2000 s.c.i.p. - the 49ers
#
# greetz to beastx and retro27
#
# $Revision: 1.3 $

use lib "perl5"; #or whatsoever
use strict;
use Crypt::CBC;
sub C;

my (
    $COLOR, $pipe, $lock, $user, $begin, $in, $mode, $remote, $dummy, $tmp, $len, $ws,
    $key, $cipher, $wr, $junk, $z, $filemode, $algo
    );


######### customize as needed #############
# set to NO if you don't prefer colors
$COLOR    = "YES";

# must be the same as your partner uses!
# your partner must be able to write there
$tmp      = "/tmp/00";

# create it with mkfifo <file>, and chmod it o+w!
$pipe     = "$tmp/hier.00";

# needs to be writable by your partner!
$lock     = "$tmp/read.00";

# store encrypted junk for verification
$junk     = "$tmp/junk.00";

# file creation mode, your partner needs also
# write permissions
$filemode = "666";

# the algorythm to be used, either "Crypt::IDEA",
# "Crypt::DES" or "Crypt::Blowfish"
$algo     = "Crypt::IDEA";

# adjust whitespaces between usename and msg. leave 8, it' quite good
$len      = 8;
######## end of customizable part #########

$SIG{INT}  = \&abort;
$SIG{TERM} = \&abort;
$SIG{USR1} = \&usr1;

$remote = shift;

if (!$remote) {
    die "usage: $0 <partner>\n";
}

if (!-e $pipe) {
    die "pipe $pipe does not exist!\n";
}

$user = $ENV{USER};

$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";

system("rm", "-rf", "$tmp/$user.00.pid");
system("touch", "$tmp/$user.00.pid");
sysopen PID, "$tmp/$user.00.pid", $filemode or die $!;
print PID $$;
close PID;

$ws = " " x ($len - length($user));
$wr = " " x ($len - length($remote));
$| = 1;




print "passphrase: ";
eval {
    local($|) = 1;
    local(*TTY);
    open(TTY,"/dev/tty");
    system ("stty -echo </dev/tty");
    chomp($key = <TTY>);
    print STDERR "\r\n";
    system ("stty echo </dev/tty");
    close(TTY);
};
if($@) {
    $key = <>;
}
chomp $key;
$cipher = new Crypt::CBC($key, $algo);







if (&lock_read) {
    # i am the first one
    my $z = time;
    open JUNK, ">$junk" or die $!;
    print JUNK $cipher->encrypt($z);
    close JUNK;
    system("chmod", $filemode, $junk);
    print "initiate connect..." . &prompt;
    $begin = "write";
}
else {
    open JUNK, "<$junk" or die $!;
    $z = <JUNK>;
    close JUNK;
    unlink $junk;
    chomp $z;
    $z = $cipher->decrypt($z);
    if ($z !~ /^\d\d\d\d\d\d\d*$/) {
	print "invalid passphrase!\n";
	&abort;
    }
    print "connected. waiting for response...\n";
    $begin = "read";
}




# main loop, run until ^C
while (1) {
    if ($begin eq "read") {
	$mode = "read";
	print &read . &prompt;
	$in = <STDIN>;
	chomp $in;
	$mode = "write";
	&write($in);
    }
    else {
	$mode = "write";
	$in = <STDIN>;
	chomp $in;
	&write($in);
	$mode = "read";
	print &read . &prompt;
    }
}


# end of script

sub prompt {
    return C "\n<<blue_>$user</blue_>>$ws";
}


sub read {
    open PIPE, "<$pipe" or die $!;
    $in = <PIPE>;
    chomp $in;
    close PIPE;
    $in = $cipher->decrypt($in);
    $in =~ s/^(.+?)$/<<BLACK>$remote<\/BLACK>>$wr<black>$in<\/black>/;
    return C $in;
}


sub write {
    my($msg) = @_;
    open PIPE, ">$pipe" or die $!;
    print PIPE $cipher->encrypt($msg);
    close PIPE;
}


sub lock_read {
    if (!-e $lock) {
	# not locked so lock it myself
	system ("touch", $lock) and die $!;
	system ("chmod", $filemode, $lock) and die $!;
	return 1;
    }
    else {
	# is locked
	unlink $lock or die $!;
	return 0;
    }
}


sub abort {
    open PID, "<$tmp/$remote.00.pid" or die "no pid file found for \"$remote\". $!\n";
    my $pid = <PID>;
    chomp $pid;
    system("rm", "-rf", "$tmp/$user.00.pid") and die "Could not remove my pidfile: $!\n";
    system("rm", "-rf", "$tmp/read.00");
    print "send kill -SIGUSR1 to $pid\n";
    system("kill", "-SIGUSR1", $pid) and die $!;
    exit;
}


sub usr1 {
    print "$remote has quit!\n";
    system("rm", "-rf", "$tmp/$user.00.pid") and die "Could not remove my pidfile: $!\n";
    exit;
}



sub C {
    my(%Color, $default, $S, $Col, $NC, $T);
    # \033[1m%30s\033[0m
    %Color = (
	      'black'         => '0;30',
	      'red'           => '0;31',
	      'green'         => '0;32',
	      'yellow'        => '0;33',
	      'blue'          => '0;34',
	      'magenta'       => '0;35',
	      'cyan'          => '0;36',
	      'white'         => '0;37',
	      'B'             => '1;30',
	      'BLACK'         => '1;30',
	      'RED'           => '1;31',
	      'GREEN'         => '1;32',
	      'YELLOW'        => '1;33',
	      'BLUE'          => '1;34',
	      'MAGENTA'       => '1;35',
	      'CYAN'          => '1;36',
	      'WHITE'         => '1;37',
	      'black_'        => '4;30',
	      'red_'          => '4;31',
	      'green_'        => '4;32',
	      'yellow_'       => '4;33',
	      'blue_'         => '4;34',
	      'magenta_'      => '4;35',
	      'cyan_'         => '4;36',
	      'white_'        => '4;37',
	      'blackI'        => '7;30',
	      'redI'          => '7;31',
	      'greenI'        => '7;32',
	      'yellowI'       => '7;33',
	      'blueI'         => '7;34',
	      'magentaI'      => '7;35',
	      'cyanI'         => '7;36',
	      'whiteI'        => '7;37'
	     );
    $default = "\033[0m";
    $S = $_[0];
    foreach $Col (%Color)
      {
	  if ($S =~ /<$Col>/g)
	    {
		if($COLOR ne "NO")
		  {
		      $NC = "\033[" . $Color{$Col} . "m";
		      $S =~ s/<$Col>/$NC/g;
		      $S =~ s/<\/$Col>/$default/g;
		  }
		else
		  {
		      $S =~ s/<$Col>//g;
		      $S =~ s/<\/$Col>//g;
		  }
	    }
      }
    return $S;
}
















