#!/usr/local/bin/perl
#
## this is output of merge.pl 0.01 ##
#
#
#
#
# version 0.1.0
#
# $Id: faxmail.pl,v 1.5 1997/08/24 21:15:22 yutaka Exp $
#

$address = "192.168.0.1"; 
$password = "password"; #<<<<<<<<<EDIT>>>>>>>>
$port = "telnet";
$user = "admin";

$myname = $0;
$myname =~ s/^..*\///g;

if ($ARGV[0] eq '-d') {
    $command = 'disconnect';
    $target = ($ARGV[1] || 'all');
    $match = '切断しました';
} elsif ($ARGV[0] eq '-s') {
    $command = 'show';
    shift @ARGV;
    $target = ($ARGV[0] ? join(' ', @ARGV) : 'status');
    $target = '' if ($target eq 'help');
    $match = '';
} elsif ($ARGV[0] eq '-c') {
    $command = 'connect';
    $target = $ARGV[1] || '0';
    $match = '接続しました';
} else {
    print STDERR "
usage: $myname { -c [No] | -d [type] | -s [type] }
         -c: No 番めの接続先に接続 (省略: #0)
         -d: 接続を切断
	  type: b1, b2 : それぞれの接続チャネル
                all    : 全てのチャネル
         -s: 状態取得
          type: キーワード (省略: status, -s help で一覧)

";
    exit 1;
}

# require 'fcntl.ph';
sub O_NONBLOCK { 04000; }
sub F_GETFL { 3; }
sub F_SETFL { 4; }

$status = 1;

&tcp'init;

eval {
    &connect_socket(*S, $address, $port);
    
    open(LOG, '>/dev/null');
    &chat_setup(*S, *S, *LOG);
    &dout("  setup done.");
    
    &chat_send("\n");

    $ret = &chat_wait(5, 0, 'login: ', 'host.');
    if ($ret == 2 || $ret == -2) {
	die '既に別の telnet 接続が存在しています';
    }
    $ret == 1 or die '交信に失敗しました';
    
    &chat_send("$user\n");
    $ret = &chat_wait(5, 0, 'Password:', 'login: ', '% ');
    if ($ret == 2) {
	die 'ユーザー admin でログインできません';
    }
    if ($ret != 3) {
	$ret == 1 or die '交信に失敗しました';
    
	&chat_send("$password\n");
	$ret = &chat_wait(5, 0, '% ', 'incorrect');
	if ($ret == 2) {
	    die 'パスワードが一致しません';
	}
	$ret == 1 or die '交信に失敗しました';
    } else {
	die 'パスワードが一致しません' if ($password ne '');
    }

    &chat_send("$command $target\n");

    $str2 = '';

    ($ret, $str) = &chat_wait(15, 0, '% ', '\n');
    $str =~ s/^[^\n]*\n//m;

    while(1) {
	die '交信に失敗しました' if $ret < 1;
	
	if ($ret == 1) {
	    $str =~ s/^\n+[^\n]*$//m;
	}
	print $str;
	$str2 .= $str;
	last if ($ret == 1);
	($ret, $str) = &chat_wait(15, 0, '% ', '\n');
    }

    if ($str2 =~ /$match/) {
	$status = 0;
    }
    &dout("string is $str2");
    
    &chat_send("logout\n");
    &chat_wait(5, 0, 'host.');
};

close(S);

if ($@) {
    $_ = $@;
    s/ at $0 line \d+\.$/\./;
    print "connect.pl: $_";
}

exit 1 if ($@ || $error);
exit $status;

################
# Communication Routines
################

sub chat_setup {
    (*CHAT_RD, *CHAT_WR, *CHAT_LOG) = @_;

    select(CHAT_RD);
    $| = 1;
    fcntl(CHAT_RD, &::F_GETFL, $flag);
    $flag |= &::O_NONBLOCK;
    fcntl(CHAT_RD, &::F_SETFL, $flag);
    select(CHAT_WR);
    $| = 1;
    select(CHAT_LOG);
    $| = 1;
    select(STDOUT);
}

# 書き込み可能かどうかをチェック。

sub chat_writable {
    local($win) = "";
    local($wout);
    local($nfound, $timeleft);
    vec($win,fileno(CHAT_WR),1) = 1;
    $nfound = select(undef, $wout = $win, undef, 0.2); # some delay allowed
    &dout ("WRITABLE? : $nfound");
    ($nfound == 1);
}

sub chat_wait {
    local($timelimit, $timewait, @wait) = @_;

    local($i) = 0;
    local($time) = 0;
    local($rout, $rin);
    local($readstr) = "";
    local($new) = "";
    local($nfound, $nread, $n, $n2, $pat);
    local($*) = 1;
    local($ret) = -1;

    $i = 0;
    &dout("  read start [$timelimit, $timewait]. patterns is:");
    foreach $pat (@wait) {
	$i++;
	&dout("    $i: $pat\$");
    }

    $timewait = 0.1 if ($timewait == 0);

  readloop:
    while (1) {
	# $timelimit 待ってもデータがなければエラー。
	$rin = "";
	vec($rin,fileno(CHAT_RD),1) = 1;
	$nfound = select($rout = $rin, undef, undef, $timelimit);
	if ($nfound != 1) {
	    &dout("TIMEOUT.");
	    $ret = -1;
	    last readloop;
	}

	$nread = 0; $new = '';
	while (1) {
	    $n = read(CHAT_RD, $n2, 2048);
	    if ($n == 0) {
		if ($nread == 0) {
		    &dout("EOF.");
		    $ret = -2;
		    last readloop;
		}
		last;
	    }
	    $rin = "";
	    $nread += $n;
	    $new .= $n2;

	    # $timewait 待ってデータがなければ次へ。
	    vec($rin,fileno(CHAT_RD),1) = 1;
	    $nfound = select($rout = $rin, undef, undef, $timewait);
	    last if ($nfound == 0);
	}

	&dout("read($nread): `$new'.");
	$new =~ s/\r//g;
	print CHAT_LOG $new;

	if (!defined $nread) {
	    $ret = -1;
	    last readloop;
	}
 
	if ($nread == 0) {
	    &dout("EOF.");
	    $ret = -2;
	    last readloop;
	} 
	
	$readstr .= $new;

	$i = 0;
	foreach $pat (@wait) {
	    $i++;
	    # check for
	    if ($readstr =~ m/$pat$/) {
		&dout("  pattern $i: $pat matched.");
		$ret = $i;
		last readloop;
	    }
	}
    }
    return wantarray ? ($ret, $readstr) : $ret;
}

sub chat_send {
    local($str) = @_;

    local($win) = "";
    local($wout);
    vec($win,fileno(CHAT_WR),1) = 1;
    $nfound = select(undef, $wout = $win, undef, 30);
    die "Chat Failure (Cannot send message)" if ($nfound != 1);

    $str =~ tr/\n\r/\r\n/;

    &dout("sent: `$str'.");
    print CHAT_WR $str;
}

sub quote {
    local($_) = @_;
    s/\n/\\n/g;
    s/\r/\\r/g;
    s/[\000-\037]/sprintf("\%03o",ord($&))/eg;
    $_;
}

sub dout {
    local($_) = @_;
    $_ = &quote($_);
#    print STDERR "$_\n";
}



#--------------------- tcp.pl begins ------------------
#!/usr/local/bin/perl
#
# tcp.pl : Easy TCP Socket Library
#
# This Package Provides:
#
# &connect_socket(Handle *Socket, String host, Int Port,
#                 optional String Situation);
# &set_timeout(Int seconds);
#
# $Id: tcp.pl,v 1.4 1997/09/15 02:21:49 yutaka Exp $
#

###  connect_socket : make a connection with TCP socket.
 
package tcp;

sub init {
    return if $inited;
    $inited = 1;

# customize values
    $SOCK_STREAM = 1;
    $AF_INET = 2;

    &alephlib'init;

    $IsWin32 = $main'IsWin32; #'
    $IsPerl5 = $main'IsPerl5; #'
    $Flag_alarm = ! $IsWin32;
    $timeout = 120;
}

sub set_timeout {
    $timeout = @_;
}

sub main'connect_socket { #'
    local(*SOCKET, $host, $port, $situation) = @_;
    local($name, $aliases, $proto, $aliases, $type, $len, $thataddr);
    local($thataddr, $that);
    local(%SIG, $mes);

    if (defined $situation) {
	$mes = " $situation:";
    } else {
	$mes = "";
    }

    # detect AF_INET value

    if (! defined $AF_INET || ! defined $SOCK_STREAM) {
	if ($IsPerl5) {
	    eval "use Socket";	# Perl5
	} else {
	    eval "require 'sys/socket.ph'";   # Perl4
	}
	die $@ if ($@);
	$AF_INET = &AF_INET;
	$SOCK_STREAM = &SOCK_STREAM;
    }

    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;

    if($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
	$thataddr = pack('c4', $1, $2, $3, $4);
    } else {
	eval {
	    $SIG{'ALRM'} = "tcp'timed_out" if ($Flag_alarm); #'
	    &set_alarm($timeout);

	    ($name, $aliases, $type, $len, $thataddr) =  gethostbyname($host);

	    &set_alarm(0);
	};

	if ($@) {
	    die "connect_socket:$mes address resolver time out.";
	}
    }

    if (! $thataddr) {
	die "connect_socket:$mes Unknown host: $host.";
    }

    $that = pack('S n a4 x8', $AF_INET, $port, $thataddr);

    if (! socket(SOCKET, $AF_INET, $SOCK_STREAM, $proto)) {
	die "socket:$mes $!.";
    }

    $Message = '';

    eval {
	
	$SIG{'ALRM'} = 'timed_out' if ($Flag_alarm);
	&set_alarm($timeout);

	if (! connect(SOCKET, $that)) {
	    &set_alarm(0);
	    $Message = "connect:$mes $!.";
	}
	&set_alarm(0);
    };

    if ($@) {
	$Message = "connect_socket:$mes connection timed out.";
    }
    if ($Message) {
	close (SOCKET);
	die $Message;
    }

    select(SOCKET); $| = 1; binmode(SOCKET); select(STDOUT);

    return 1;
}

sub timed_out {
    die "";
}

sub set_alarm {
    alarm($_[0]) if ($Flag_alarm);
}

&init;
1;

package main;
exit 0; # ----------- end of tcp.pl ------------------


#--------------------- alephlib.pl begins ------------------
######################################################################
#
# Aleph's Library: Some Common Perl Routine
#
######################################################################

# this package provides:
#  $HomeDirectory
#  $IsWin32
#  $IsPerl5
#  $CommandName
#  $PerlSpec
#  $OSType

# $Id: alephlib.pl,v 1.5 1997/09/14 19:49:15 yutaka Exp yutaka $

package alephlib;

sub init {
    return if $inited;
    $inited = 1;

    &detect_environment;
    $ScriptName = &get_command_name;
    $HomeDirectory = &get_user_vicinity;

    # export value
    $main'HomeDirectory = $alephlib'HomeDirectory;
    $main'ScriptName = $alephlib'ScriptName;
    $main'IsWin32 = $alephlib'IsWin32;
    $main'IsPerl5 = $alephlib'IsPerl5;
    $main'OSType = $alephlib'OSType;
    $main'PerlSpec = $alephlib'PerlSpec;
}

sub yesno {
    $_[0] ? "yes" : "no";
}

sub diagnostics {
    printf "
Alephlib Diagnostics:
  Is This Perl Version5? : %s
  Is This Perl Win32's?  : %s
  OS Type                : %s
  Script name            : %s
  Home Directory         : %s
  Perl Spec String       : %s
", &yesno($IsPerl5), &yesno($IsWin32), $OSType,
      $ScriptName, $HomeDirectory, $PerlSpec;
}

sub get_command_name {
    local($_) = $0;

    s|^..*/||o;
    s|\.[a-z]+$||io;		# extension .pl (.bat in Win32)
    y/A-Z/a-z/;
    
    $_;
}

sub get_user_vicinity {
    if ($IsWin32) {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} || $ENV{'windir'};
	s/\\/\//g;
    } else {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
	    (getpwuid($<))[7];
    }
    $_ || die "$ScriptName: Can't find Home Directory!\n";
}

sub detect_environment {
    local ($@); # Error Trap is Local
    local ($string, $major, $minor, $build, $id, $specstr);
    local ($osname, $nodename, $release, $reldate, $domainname);
    $IsWin32 = 0; #'

    eval q|$_ = &Win32'GetCwd;|;	#'
    $IsWin32 = 1 if (!($@)); 

    $PerlVersion = sprintf ("%g", $] + 0);
    $IsPerl5 = ($PerlVersion > 5.0); 

    if ($IsWin32) {
	# Win32 environ detection
	# I think all "Perl for Win32" are Perl5,
	# but take care.
	eval q|
	    ($string, $major, $minor, $build, $id) = &Win32'GetOSVersion; #'
	|;
	$OSType = ('Win+Win32S', 'Win95', 'WinNT')[$id];
	if ($string eq '') {
	    $OSType = sprintf("%s %d.%02d", $OSType, $major, $minor);
	} else {
	    $string =~ s/\b(\S+)\b +/\u$1/g;
	    $OSType = sprintf("%s %d.%02d-%s", $OSType, $major, $minor, $string);
	}
	if ($@) {
	    $OSType = "Win-Unknown";
	}
	$PerlSpec = "Perl $PerlVersion-Win32, " . &Win32'PerlVersion . #'
	    ", $OSType";
    } else {
	if ($IsPerl5) {
	    eval '
		use POSIX; 
		($osname, $nodename, $release, $reldate, $domainname)
		    = &POSIX::uname;
		$OSType = ucfirst("$osname $release");
	    ';
	    if ($@) {
		eval '
		    use Config; 
		    $OSType = ucfirst($Config{"osname"});
		';
		if ($@) {
		    $OSType = $ENV{'OSTYPE'} || 'Unix';
		    $OSType = "\u$OSType";
		}
	    }
	} else {
	    $OSType = $ENV{'OSTYPE'} || 'Unix';
	    $OSType = "\u$OSType";
	}
	$PerlSpec = "Perl $PerlVersion, $OSType";
    }
}

&init;
1;

package main;
exit 0; # ----------- end of alephlib.pl ------------------

