#!/usr/bin/perl
use Getopt::Std;
use POSIX;
use Socket;
require 'jcode.pl' if ($ENV{LANG} =~ /^ja/);

$VERSION = '0.0'; # $GENERIC = '20001009';
$IPMSGINF = "$0 $VERSION written by Taiji Yamada <taiji\@aihara.co.jp>";
$IPMSGVER = 1; 
%IPMSGCMD = (
	     NOOPERATION	=> 0x00000000,
	     BR_ENTRY		=> 0x00000001,
	     BR_EXIT		=> 0x00000002,
	     ANSENTRY		=> 0x00000003,
	     BR_ABSENCE		=> 0x00000004,
	     #
	     BR_ISGETLIST	=> 0x00000010,
	     OKGETLIST		=> 0x00000011,
	     GETLIST		=> 0x00000012,
	     ANSLIST		=> 0x00000013,
	     #
	     SENDMSG		=> 0x00000020,
	     RECVMSG		=> 0x00000021,
	     #
	     READMSG		=> 0x00000030,
	     DELMSG		=> 0x00000031,
	     #
	     GETINFO		=> 0x00000040,
	     SENDINFO		=> 0x00000041,
	     #
	     GETABSENCEINFO	=> 0x00000050,
	     SENDABSENCEINFO	=> 0x00000051,
	     );
%IPMSGOPT = (
	     ABSENCE		=> 1<< 8,
	     DIALUP		=> 1<<12,	# not yet
	     SENDCHECK		=> 1<< 8,
	     SECRET		=> 1<< 9,
	     BROADCAST		=> 1<<10,
	     MULTICAST		=> 1<<11,
	     AUTORET		=> 1<<13,	# not yet
	     RETRY		=> 1<<14,	# not yet
	     PASSWORD		=> 1<<15,
	     NOLOG		=> 1<<17,
	     NOADDLIST		=> 1<<19,
	     );
$MAX_UDPBUF = 8192;

sub is_cmd {
  my($cmd, $name) = @_;
  return (($cmd & 0xff) == $IPMSGCMD{$name});
}
sub cmdname {
  my($cmd) = @_;
  foreach my $name (sort keys %IPMSGCMD) {
    return $name.mskname($cmd) if (is_cmd($cmd, $name));
  }
}
sub has_msk {
  my($cmd, $name) = @_;
  return (($cmd & 0xffffff00) & $IPMSGOPT{$name});
}
sub mskname {
  my($cmd) = @_;
  my($msk) = undef;
  foreach my $name (sort keys %IPMSGOPT) {
    $msk .= "|$name" if (has_msk($cmd, $name));
  }
  return $msk;
}

sub usage {
  print <<EOF;
name:
	$0 - perl IP Messenger, version $VERSION
synopsis:
	$0 [-p port] [-u user] [-l localhost] [-g group] [-b broadcast(s)]
		[[-t] target|all] [-s|-k] [-i ico] [-o list] [-d]
		[-r] [-L] [-G] [-I] [-B] [-E|-X] [-P|-A] [-T|-S]
options:
	-r	receive IP Messenger protocol until stopped
	-L	broadcast ISGETLIST
	-G	send GETLIST command to target host(s)
	-I	send GETINFO command to target host(s)
	-B	send GETABSENCEINFO command to target host(s)
	-E	broadcast ENTRY
	-X	broadcast EXIT
	-P	broadcast PRESENCE
	-A	broadcast ABSENCE
	-T	throw message of stdin to target host(s)
	-S	send message of stdin to target host(s)
	-s	message in sealed letter
	-k	message in sealed and keyed letter
	-i	specify bitmap icon to send, xipmsg doesn't neglect it
	-o	output file to list hosts only when specified
	-d	disable external control by special message from localhost
author:
	taiji\@aihara.co.jp
EOF
  exit(0);
}

(getopts("hp:u:l:g:b:t:ski:o:drLGIBEXPATS") && !$opt_h) || usage();
$port	= $opt_p ? $opt_p : 2425;
$user	= $opt_u ? $opt_u : $ENV{'USER'};
$local	= $opt_l ? $opt_l : $ENV{'HOST'};
$group	= $opt_g;
$baddr	= $opt_b ? $opt_b : undef;
$target	= $opt_t ? $opt_t : $ARGV[0] ? $ARGV[0] : 'localhost';
$seal	= $opt_s;
$key	= $opt_k;
$face	= $opt_i ? $opt_i : undef;

$proto	= getprotobyname('udp');
$port	= getservbyname($port, 'udp') unless $port =~ /^\d+/;
$soopen	= 0;
$packno	= $$;
%hosts	= undef;

sub broadcast {
  my($target, $cmd, $msg, $dat) = @_;
  my($sin, $buf);
  printf STDERR ("broadcast: %s: %s: %s\n",
		 !$target ? inet_ntoa(INADDR_BROADCAST) : $target,
		 cmdname($cmd), $msg) if ($^D > 3);
  socket(S, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!" if (!$soopen);
  $sin = sockaddr_in($port, !$target ? INADDR_BROADCAST : inet_aton($target));
  select(S); $| = 1; select(STDOUT); $soopen = !0;
  $buf = sprintf("%d:%ld:%s:%s:%ld:%s", $IPMSGVER, $packno++,
		 $user, $local, $cmd, $msg);
  jcode::convert(\$buf, 'sjis') if ($ENV{LANG} =~ /^ja/);
  send(S, $buf."\0".$dat, 0, $sin);
}
sub broadcasts {
  my($cmd, $msg, $dat) = @_;
  if (!$baddr) {
    broadcast('', $cmd, $msg, $dat);
  }
  else {
    foreach my $target (split(/,/, $baddr)) {
      broadcast($target, $cmd, $msg, $dat);
    }
  }
}
sub sends {
  my($target, $cmd, $msg, $dat) = @_;
  if ($target eq 'all') {
    $cmd |= $IPMSGOPT{BROADCAST};
    return broadcasts($cmd, $msg, $dat);
  }
  elsif ((my @targets = split(/,/, $target)) > 1) {
    $cmd |= $IPMSGOPT{MULTICAST};
    foreach $target (@targets) {
      sends($target, $cmd, $msg, $dat);
    }
    return;
  }
  my($sin, $buf);
  printf STDERR ("sends: $target: %s: %s\n", cmdname($cmd), $msg) if ($^D > 3);
  socket(S, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!" if (!$soopen);
  $sin = sockaddr_in($port, inet_aton($target));
  select(S); $| = 1; select(STDOUT); $soopen = !0;
  $buf = sprintf("%d:%ld:%s:%s:%ld:%s", $IPMSGVER, $packno++,
		 $user, $local, $cmd, $msg);
  jcode::convert(\$buf, 'sjis') if ($ENV{LANG} =~ /^ja/);
  send(S, $buf."\0".$dat, 0, $sin);
}
sub slice_binary_buffer {
  my($bb, $max_slice) = @_;
  my $i = 0, @bb = undef;
  foreach my $c (unpack("C".length($bb), $bb)) {
    if ($c == 0 && (!$max_slice || $max_slice > $i)) {
      $i++;
      next;
    }
    $bb[$i] .= pack("C", $c);
  }
  return @bb;
}
sub is_myaddr {
  my($addr) = @_;
  (($addr eq '127.0.0.1') || $addr eq inet_ntoa(inet_aton($ENV{HOST})));
}
sub receive {
  my($sin);
  socket(S, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
  $sin = sockaddr_in($port, INADDR_ANY);
  bind(S, $sin) || die "bind: $!";
  select(S); $| = 1; select(STDOUT); $soopen = !0;
  #
  # single-throw or round-trip actions
  #
  $opt_E && entry();
  $opt_P && present();
  $opt_A && absent();
  $opt_T && throw_message($target);
  $opt_S && send_message($target, $IPMSGOPT{SENDCHECK});
  $opt_L && broadcasts($IPMSGCMD{BR_ISGETLIST});
  $opt_G && sends($target, $IPMSGCMD{GETLIST});
  $opt_I && sends($target, $IPMSGCMD{GETINFO});
  $opt_B && sends($target, $IPMSGCMD{GETABSENCEINFO});
  $opt_X && ($SIG{'ALRM'} = sub () { noentry() if ($entried); }, alarm(6));
  #
  # conversation with others
  #
  while (!0) {
    my($from) = recv(S, $bb, $MAX_UDPBUF, 0);
    my($port, $iaddr) = sockaddr_in($from);
    my($src) = inet_ntoa($iaddr);
    my($buf, $bb) = slice_binary_buffer($bb, 1);
    print STDERR ("receive: $src: ") if ($^D > 3);
    jcode::convert(\$buf, 'euc', 'sjis') if ($ENV{LANG} =~ /^ja/);
    unless ($buf =~ /^([^:]+):([^:]+):([^:]*):([^:]*):([^:]+):/) {
      print STDERR ("illegal protocol format\n") if ($^D > 3);
      next;
    }
    my($ver, $packno, $usr, $host, $cmd, $msg) = ($1, $2, $3, $4, $5, $');
    printf STDERR ("$usr: $host: %s: %s\n", cmdname($cmd), $msg) if ($^D > 3);
    if (is_cmd($cmd, BR_ENTRY)) {
      sends($src, $IPMSGCMD{ANSENTRY}, "$user") if ($entried);
      host_entry($usr, $host, 0, $src, $port, $msg, $bb);
    }
    elsif (is_cmd($cmd, BR_EXIT)) {
      host_delete($usr, $host, 0, $src, $port, $msg);
    }
    elsif (is_cmd($cmd, ANSENTRY)) {
      host_entry($usr, $host, 0, $src, $port, $msg, $bb);
    }
    elsif (is_cmd($cmd, BR_ABSENCE)) {
      host_entry($usr, $host, has_msk($cmd, ABSENCE), $src, $port, $msg, $bb);
    }
    elsif (is_cmd($cmd, SENDMSG)) {
      if (has_msk($cmd, BROADCAST)) {
	;
      }
      elsif (has_msk($cmd, AUTORET)) {
	;
      }
      elsif (has_msk($cmd, SENDCHECK)) {
	sends($src, $IPMSGCMD{RECVMSG}, "$packno");
      }
      if (has_msk($cmd, SECRET)) {
	# snap reaction to show message
	#receipt_message($usr, $host, $msg, !0, has_msk($cmd, PASSWORD));
	#sends($src, $IPMSGCMD{READMSG}, "$packno");
	# read or delete message later on
        hold_letter($src, $packno,
		    $usr, $host, $msg, !0, has_msk($cmd, PASSWORD));
      }
      else {
	if (!is_myaddr($src) || $opt_d) {
	  receipt_message($usr, $host, $msg);
	}
	else {
	  ($msg =~ /^-u (\S+)/) && ($user = $1);
	  ($msg =~ /^-l (\S+)/) && ($local = $1);
	  ($msg =~ /^-g (\S+)/) && ($group = $1);
	  ($msg =~ /^-b (\S+)/) && ($baddr = $1);
	  ($msg =~ /^-s/) && ($seal = !$seal);
	  ($msg =~ /^-k/) && ($key = !$key);
	  ($msg =~ /^-i (\S+)/) && ($face = $1);
	  ($msg =~ /^-R/) && pull_letter();
	  ($msg =~ /^-D/) && pull_letter(!0);
	  #
	  # single-throw or round-trip actions directed by localhost message
	  #
	  ($msg =~ /^-E/) && entry();
	  ($msg =~ /^-P/) && present();
	  ($msg =~ /^-A/) && absent();
	  ($msg =~ /^-T (\S+)/) && throw_message($1);
	  ($msg =~ /^-S (\S+)/) && send_message($1, $IPMSGOPT{SENDCHECK});
	  ($msg =~ /^-L/) && broadcasts($IPMSGCMD{BR_ISGETLIST});
	  ($msg =~ /^-G (\S+)/) && sends($1, $IPMSGCMD{GETLIST});
	  ($msg =~ /^-I (\S+)/) && sends($1, $IPMSGCMD{GETINFO});
	  ($msg =~ /^-B (\S+)/) && sends($1, $IPMSGCMD{GETABSENCEINFO});
	  ($msg =~ /^-X/) && noentry();
	}
      }
      unless (has_msk($cmd, NOLOG)) {
	;
      }
      unless (has_msk($cmd, NOADDLIST)) {
	host_entry($usr, $host, undef, $src, $port);
      }
    }
    elsif (is_cmd($cmd, RECVMSG)) {
      ;
    }
    elsif (is_cmd($cmd, READMSG)) {
      ;
    }
    elsif (is_cmd($cmd, BR_ISGETLIST)) {
      if (!is_myaddr($src)) {
	sends($src, $IPMSGCMD{OKGETLIST});
      }
      else {
	$SIG{'ALRM'} = sub () { sends($src, $IPMSGCMD{OKGETLIST}); }; alarm(3);
      }
    }
    elsif (is_cmd($cmd, OKGETLIST)) {
      sends($src, $IPMSGCMD{GETLIST});
    }
    elsif (is_cmd($cmd, GETLIST)) {
      if (!is_myaddr($src)) {
	send_hosts($src);
      }
      else {
	$SIG{'ALRM'} = sub () { send_hosts($src); }; alarm(3);
      }
    }
    elsif (is_cmd($cmd, ANSLIST)) {
      receipt_hosts($usr, $host, $msg);
      last if (!$opt_r && ($opt_L || $opt_G));
    }
    elsif (is_cmd($cmd, GETINFO)) {
      sends($src, $IPMSGCMD{SENDINFO}, $IPMSGINF);
    }
    elsif (is_cmd($cmd, SENDINFO)) {
      receipt_message($usr, $host, $msg);
      last if (!$opt_r && $opt_I);
    }
    elsif (is_cmd($cmd, GETABSENCEINFO)) {
      sends($src, $IPMSGCMD{SENDABSENCEINFO}, $absent ? "Absent" : "Present");
    }
    elsif (is_cmd($cmd, SENDABSENCEINFO)) {
      receipt_message($usr, $host, $msg);
      last if (!$opt_r && $opt_B);
    }
  }
}
$entried = 0;
sub entry {
  $entried = !0;
  my($bb) = $group;
  $bb && jcode::convert(\$bb, 'sjis') if ($ENV{LANG} =~ /^ja/);
  broadcasts($IPMSGCMD{BR_ENTRY}, $user, $bb);
}
sub noentry {
  $entried = 0;
  broadcasts($IPMSGCMD{BR_EXIT});
}
$absent = 0;
sub present {
  $absent = 0;
  my($bb) = $group;
  $bb && jcode::convert(\$bb, 'sjis') if ($ENV{LANG} =~ /^ja/);
  broadcasts($IPMSGCMD{BR_ABSENCE}, $user, $bb);
}
sub absent {
  $absent = !0;
  my($bb) = $group;
  $bb && jcode::convert(\$bb, 'sjis') if ($ENV{LANG} =~ /^ja/);
  broadcasts($IPMSGCMD{BR_ABSENCE} | $IPMSGOPT{ABSENCE}, $user, $bb);
}
sub host_entry {
  my($usr, $host, $msk, $addr, $port, $nam, $grp) = @_;
  my(@this) = $hosts{$addr} ? split(/\x07/, $hosts{$addr}, -1) : undef;
  $grp && jcode::convert(\$grp, 'euc', 'sjis') if ($ENV{LANG} =~ /^ja/);
  $msk = $msk ? $msk : $this[2] ? $this[2] : 0;
  $nam = $nam ? $nam : $this[5] ? $this[5] : "\x08";
  $grp = $grp ? $grp : $this[6] ? $this[6] : "\x08";
  $hosts{$addr} = join("\x07", $usr, $host, $msk, $addr, $port, $nam, $grp);
  write_hosts($opt_o) if ($opt_o);
}
sub host_delete {
  my($usr, $host, $msk, $addr, $port, $nam, $grp) = @_;
  delete $hosts{$addr};
  write_hosts($opt_o) if ($opt_o);
}
sub sprint_hosts {
  my($buf) = sprintf("%d\x07%4d\x07", 0, (%hosts-1));
  foreach my $host (values %hosts) {
    $buf .= "$host\x07";
  }
  return $buf;
}
sub reform_hosts {
  my($buf) = @_;
  $buf =~ s/^([^\x07]+\x07*){2}//;
  $buf =~ s/(([^\x07]+\x07*){7})/\1\0/g;
  $buf = join("\0", sort split(/\0/, $buf));
  $buf =~ y/\0\x07/\n:/; $buf =~ y/\x08//d;
  return $buf;
}
sub send_hosts {
  my($dst) = @_;
  sends($dst, $IPMSGCMD{ANSLIST}, sprint_hosts());
}
sub receipt_hosts {
  my($usr, $host, $msg) = @_;
  receipt_message($usr, $host, reform_hosts($msg));
}
sub write_hosts {
  my($ofile) = @_;
  if (open(O, ">$ofile")) {
    print O reform_hosts(sprint_hosts());
    close(O);
  }
  else {
    print STDERR "$0: can't open $ofile to list hosts\n";
  }
}
sub bitmap {
  my(@icon) = (0xff,0xff,0xff,0xff,0x01,0x54,0x55,0xa5,
	       0x01,0x94,0x54,0xaa,0x01,0xa8,0x4a,0xd5,
	       0x01,0x50,0x55,0xa1,0x01,0xa8,0x50,0xc8,
	       0x01,0x90,0xa0,0xa0,0x01,0x50,0x24,0xc8,
	       0x01,0xa8,0x20,0xa2,0x01,0x54,0x88,0xa0,
	       0x01,0x54,0x22,0xaa,0x07,0xa5,0x08,0xd0,
	       0x79,0x55,0xa1,0xaa,0x47,0x95,0x0a,0xd4,
	       0xa9,0xaa,0x20,0x92,0x2b,0x09,0x08,0xd5,
	       0x55,0x05,0xa0,0xaa,0xab,0x40,0x0a,0xca,
	       0xa5,0x10,0x20,0xd5,0x2b,0x44,0x0d,0xa9,
	       0x55,0x80,0x52,0xca,0x13,0xa8,0x0a,0xaa,
	       0x2f,0x62,0x8f,0xf8,0x3b,0xc8,0x25,0xa8,
	       0x2b,0x71,0x8f,0xfa,0x3d,0xb0,0x75,0xac,
	       0x57,0x6d,0xdf,0xff,0xfb,0xff,0x6a,0xff,
	       0x57,0xff,0xb7,0xfd,0xfb,0xfe,0xff,0xff,
	       0xd7,0xed,0xff,0xff,0xff,0xff,0xff,0xff);
  my($icon) = @_;
  if (-f $icon && (open(ICON, "convert -sample 32x32 $icon xbm:- |") ||
		   open(ICON, "$icon"))) {
    $/ = undef;
    @icon = map hex($_), grep /^0x[0-9a-fA-F]{2}/, split(/\b/, <ICON>);
  }
  return pack("C128", @icon);
}
sub send_message {
  my($dst, $msk, $msg) = @_;
  my($cmd);
  $msk |= $IPMSGOPT{SECRET} if ($seal);
  $msk |= $IPMSGOPT{SECRET} | $IPMSGOPT{PASSWORD} if ($key);
  $cmd = $IPMSGCMD{SENDMSG} | $msk;
  print STDERR ("message: stdin\n") if ($^D > 3);
  if (!$msg) { # stdin
    $msg .= $_ while (<STDIN>);
  }
  sends($dst, $cmd, $msg, $face ? bitmap($face) : undef);
}
sub throw_message {
  my($dst, $msk, $msg) = @_;
  send_message($dst, $msk | $IPMSGOPT{NOLOG} | $IPMSGOPT{NOADDLIST}, $msg);
}
sub receipt_message {
  my($usr, $host, $msg, $sealed, $keyed) = @_;
  # stdout
  print ("message ".($keyed ? "keyed " : $sealed ? "sealed " : "").
	 "from $usr\@$host at ".strftime("%C", localtime(time()))."\n$msg\n");
}
@holder = undef;
sub hold_letter {
  my($addr, $packno, $usr, $host, $msg, $sealed, $keyed) = @_;
  push(@holder, [$addr, $packno, $usr, $host, $msg, $sealed, $keyed]);
  receipt_message($usr, $host, '#'.(@holder-1), $sealed, $keyed);
}
sub pull_letter {
  my($tear) = @_;
  my($addr, $packno, $usr, $host, $msg, $sealed, $keyed) = @{pop(@holder)};
  return if (!$addr);
  receipt_message($usr, $host,
		  !$tear ? $msg.'open #'.@holder : 'deleted #'.@holder,
		  $sealed, $keyed);
  sends($addr, !$tear ? $IPMSGCMD{READMSG} : $IPMSGCMD{DELMSG}, "$packno");
}
sub atquit {
  if (@holder) {
    pull_letter() while (@holder);
  }
  noentry() if ($entried);
  exit(0);
}
#
# conversation with others
#
if ($opt_r) {
  $SIG{'INT'} = \&atquit;
  receive(); exit(0);
}
#
# possible round-trip actions
#
if ($opt_L || $opt_G || $opt_I || $opt_B) {
  $SIG{'ALRM'} = \&atquit; alarm(9);
  receive(); exit(0);
}
#
# possible single-throw actions but disagreeable except for throw_message
#
$opt_E && entry();
$opt_P && present();
$opt_A && absent();
$opt_T && throw_message($target);
$opt_S && send_message($target);
$opt_X && noentry();