package portmaster;

########################################################################
# PM-Perl v2.1
# ------------    Patches: Josh Wilmes <josh@sky.net>
#                 Tested with perl 5.003 and ComOS 3.3.1/3.5.
# Changes:
# - rewrite of SimplePacket to correctly handle larger packets.
# - fixed select() bugs (incorrect return value checks)
# - modified Get to return exactly the number of bytes requested where
#   possible
# - added ShortGet which does the previous Get behavior..
# - rewrite of Who handling for ports > 9. 
# - changed Login to use Get instead of SimplePacket (it wasn't really a 
#   normal packet)

########################################################################
# PM-Perl v2.02
#               patches for Solaris 2.x Mike D. Kail <mdkail@fv.com>

########################################################################
#
# PM-Perl v2.01
#
# Patches      : Gary E. Miller <gem@rellim.com>
#                Dave Carmean <dlc@silcom.com>
# Interpreter  : Perl v5.002
# Portmaster   : ComOS 3.3.1
#
#######################################################################

########################################################################
#
# PM-Perl v1.0 
#
# Author       : Brian Pollack
# Interpreter  : Perl v5 pl001e Copyright (C) 1995 Larry Wall
# Design System: BSD/OS 2.0 Copyright (C) 1995 Berkeley Systems, Inc.
# Portmaster   : v3.1.2 Copyright (C) 1995 Livingston Enterprises, Inc.
#
#######################################################################

#######################################################################
# Copyright Abandoned 1996 by Brian Pollack
#
# This code has not been approved by Livingston Enterprises, and may
# render a portmaster useless.  Do not attempt to use this unless you
# have a full understanding of what you are doing.
####################################################################### 

###############################################################################
###############################################################################
# I Keep my portmaster password listed in the library so that all clients
# can see it.  You can either put your password here (be careful about
# who can read this file) or specify it in any of the programs from the
# command line.

$main::Password = 'sAp01q2w';

# set this to your local domain name
$main::Domain = ".sky.net";

# set this to the names of all your portmasters
# it is used by programs that query multiple pm's
@main::All = ("ts-1.kc.sky.net",
	      "ts-2.kc.sky.net",
	      "ts-3.kc.sky.net",
	      "ts-4.kc.sky.net",
	      "ts-1.sky.net",
	      "ts-3.sky.net");

# this is a list of usernames, with out servive prefix/suffix to
# ignore when checking duplicate logins, idle time, max time, etc.

# 'PP' is an artifact during logins
# 'PPP' is returned during logins
@main::Gods=('PP', 'PPP');
# end of (most) site dependent variables
###############################################################################
###############################################################################

require 'shellwords.pl';
use strict; 
no strict "subs";  #comment out when debugging
use Socket;

# --------------------------------------------------------------------------- 

# Globals
my (%Global,@Words,$Port);

#---------------------------------------------------------------------------- 
# To change the debugging options,  Change this procedure
#---------------------------------------------------------------------------- 
sub Debug {
  #XXX# Remove this return line for debugging #XXX#
  return;
  my($Line) = join('', @_);
  $Line =~ s/\r/\\r/g;
  $Line =~ s/\n/\\n/g;
  print "[$Line]\n";
}


#---------------------------------------------------------------------------- 
# This is the magic of the library.  It grabs the data from the port
# and magically returns
#---------------------------------------------------------------------------- 
sub Get {
  # Returns Data read
  my($Count) = @_;
  my($Line) = "";
  my($Line2);
  my($Data,$len);

  my($ReadBits, $Found, $Dev);
  $ReadBits = '';
  vec($ReadBits, fileno(main::DS), 1) = 1;
  $Found = select($Dev = $ReadBits, undef, undef, 5);
  if ($Found != 1) {      
      Debug "NO DATA FOUND on Call from ", caller;
  } else {
      recv(main::DS, $Line, $Count, 0) || warn ("recv: $!\n");
      $len=length($Line)+1;
      if ($len < $Count) { 
	  # recv will not always return the full size you requested.  If we 
	  # have not gotten all the data we wanted, try one more time.

	  # select to wait 5 seconds for data to arrive.. (avoid blocking
	  # forever)
	  if (select($Dev = $ReadBits, undef, undef, 5)) {
	      recv(main::DS, $Line2, $Count-$len+1, 0) || warn ("recv: $!\n");
	      $Line .= $Line2;
	  } else {
	      print "portmaster::Get timeout on short read.\n";
	  }
      }
      Debug "Read: \"$Line\"";
  }
  return $Line;
}


sub ShortGet {
    # Like get, but will allow short reads.
    
    # Returns Data read
    my($Count) = @_;
    my($Line) = "";
 
    my($ReadBits, $Found, $Dev);
    $ReadBits = '';
    vec($ReadBits, fileno(main::DS), 1) = 1;
    $Found = select($Dev = $ReadBits, undef, undef, 5);
    if ($Found != 1) {      
	Debug "NO DATA FOUND on Call from ", caller;
    } else {
	recv(main::DS, $Line, $Count, 0) || warn ("recv: $!\n");
	Debug "Read: \"$Line\"";
    }

    return $Line;
}


#---------------------------------------------------------------------------- 
# Send data to the port
#---------------------------------------------------------------------------- 
sub Send {
  my($Sent) = send(main::DS, $_[0], 0);
}

#---------------------------------------------------------------------------- 
# This calls get and what ever other procedure to actually for a complete
# response packet.  If the pm protocol ever changes, this is the location
# that needs to be changed.
#---------------------------------------------------------------------------- 
sub SimplePacket {
    # Read a response from the Portmaster

    # Each response begins with a 4-byte header.  The last two bytes are 
    # a short int in network byte order representing the number of bytes 
    # to follow.
    my ($Length,$Response,$e1,$e2);

    $Response = Get 4;
    Debug "portmaster::SimplePacket Header: \"$Response\"";

    if (substr($Response, -1, 1) eq "\0") {
	# Continuation of previous packet.

	$Response = ShortGet 500;
	do {
	    Send "e\0
\0\001";
	    $e2 = ShortGet 500; 
	    $Response .= substr($e2, 4, 496);
	    Send "e\0\001\0"; 
	    $e1 = ShortGet 10;
	} until (length($e2) == 4);
	
    } else {
	# regular packet.

	($Length) = unpack('xxn', $Response);
	$Length++;
	
	if (!($Response =~ /^e\t/)) {
	    # normal packet headers start with the e<tab>.. If this one 
	    # doesn't, this packet is probably bad.  For now, just warn them.
	    print "portmaster::SimplePacket: Bad packet?\n"; 
	}
	
	$Response = Get $Length;
    }
    
    return $Response;
}


#---------------------------------------------------------------------------- 
# This is first User callable procedure.  It will send the command
# passed to it to the portmaster.  If you ask for an array to be sent
# back, it will have the data sent back from the portmaster, otherwise
# it is displayed to the screen.
#---------------------------------------------------------------------------- 
sub Command {
  my($Cmd) = @_;
  Debug "Command: $Cmd\n";
  Send "e\0" . pack("C", length($Cmd)+1) . "$Cmd\0";
  my($Resp) = SimplePacket;
  Debug "Response to Command $Cmd: $Resp";

  if ($Resp != "s") {
     warn "Command $Cmd Failed\n";
     return;
  } 

  # Request the data be sent back to us
  Send "e\0\001\0";
  $Resp = &SimplePacket;
  if (wantarray) {
     return split('\n', $Resp);
  } else {
     print "$Resp";
  }
}


#---------------------------------------------------------------------------- 
# Login to the portmaster
#---------------------------------------------------------------------------- 
sub Login {
  # Sends the request for login
  my($Pass) = @_;
  Send "e\0" . pack('C1', length($Pass)+1) . $Pass . "\0";

  Get 4;             # packet header
  my($Resp) = Get 1; #  response
  if ($Resp eq "s") {
     Debug "Login Sucessful.";
  } else {
     Debug "Response: $Resp";
     die "Login Failed.";
  }
  return 0;
}

#---------------------------------------------------------------------------- 
# Connect to the portmaster.  A connection must be established before 
# login message can be sent.  Connect calls login with the username and
# password.
#---------------------------------------------------------------------------- 
sub Connect {
  # Usage: 
  # Connect Portmaster Password
  my($Portmaster, $Password) = @_;

  $Global{Portmaster} = $Portmaster;

  my($Remote) = gethostbyname $Portmaster;
  # Gethostbyname expands hosts the first time ie..localhost=localhost.domain
  if (length($Remote) == 0) {
      # not found
      return 1;
  } elsif (length($Remote) != 4) {
     $Remote = gethostbyname $Remote;
  }
  $Global{Remote} = $Remote;

  # get a tcp socket
  my($proto) = getprotobyname('tcp');
  socket(main::DS, PF_INET, SOCK_STREAM, $proto)	|| die "Socket: $!";

  # this next statement does not work on Linux 2.0.0
  # please try it and e-mail if it works for you gem@rellim.com
  # I don't even know what it does - gem
  # setsockopt(main::DS, 65535, 0x0200, 1)	|| die "Sockopt: $!";

  # use it to connect to the portmaster
  my($RemoteAddr) = "";
  $RemoteAddr = sockaddr_in( 1643, $Remote); 

  connect(main::DS, $RemoteAddr)		|| die "Connect: $!";
  my $Last = select(main::DS); 
  $| = 1;
  select($Last);
  Debug "Connected to Portmaster $Portmaster\n";
  return Login $Password;
}

# ========== Some nice and handy routines ==========================


#---------------------------------------------------------------------------- 
# This will set any port to be a dialout port (so that you can telnet to
# it or run an expect script on it)
#---------------------------------------------------------------------------- 
sub SetDialout {
  my($Port, $Speed, $Data, $Parity) = @_;
  $Port =~ s/[Ss]//g;

  Command("set s$Port device /dev/network");
  Command("set s$Port service_device telnet 300$Port");
  Command("set s$Port modem off");
  Command("reset s$Port");
}

# ========== ThIs is all used for the readConf Procedure ===========

sub set {
  my($Var, $Str, $Ofs, $Len) = @_;
  $main::Config{$Var} = substr($Str, $Ofs, $Len);
  Debug "Set $Var to $main::Config{$Var}";
}

sub ip {
  my($Resp, $Offset) = @_;
  my($a,$b,$c,$d) = unpack('C4', substr($Resp, $Offset, 4));
  return ("$d.$c.$b.$a", 0, 15);
}

#---------------------------------------------------------------------------- 
# The cheezy attempt I made to copy Readconf.
# This is here for historic reasons, the SysGlobal procedure
# is much better
#---------------------------------------------------------------------------- 

sub ReadConf {
  # The portmaster can "upload" a number of "files" to you via this
  # command.  The files names that I know about:

  #  confr2, config, pm.cnf, hosttab, routes
  #  passwd, location, script, filter, netmasks
  #  sapfilt, ipxfilt, snmp

  my($File) = "routes"; 

  Send "e\0" . pack("C", length($File)+1) . $File . "\0\0";
  #my $Resp = Get 16;
  my($Resp) = &SimplePacket;
  return if (substr($Resp, -1, 1) ne "s");

  #Send "e
\0\0\012\0";
  Send "e
\0\0\014\0";
  $Resp = &SimplePacket;
}

# This is a small tool to set a variable to popped value
sub Globalset {
   my($What);
   foreach $What (@_) {
     $main::GlobalValue{$What} = shift(@Words);
     Debug "Global-$What: ", $main::GlobalValue{$What};
   }
}

sub SysGlobal {
  Send "e\0
\0";
  my($Pack) = &SimplePacket;
  
  # I am not sure what people what with these values, or what
  # most of them actaully ARE, so I will just return them.
  # Here is what I have so far (possible code in your program)
  # Check out pminfo for an example of the values
  # returned here

  my(@Ret) = @Words = split(' ', $Pack);

  Globalset(HD, IPADDRESS, DEFHOST, IPGATEWAY, NETMASK, NUMPORTS, STATUS,
     VERSION, ALTHOST, ADDR10,  ADDR11,   NAMESERVER1, DOMAIN,
     NAMESVC, TELNET, LOGHOST, ASSIGNED, UN18, UN19,   UN20,
     UN21,  RADIUS, ALTRADIUS, UN24,   UN25, IPXADDRESS, UN27, UN28,
     UN29, UN30, NAMESERVER2, UN32, UN33, UN34, UN35, UN36, UN37, UN38,
     UN39, UN40);

  $main::GlobalValue{NUMPORTS}--; # fix port count ?
  if ( $main::GlobalValue{NAMESVC} == '723') {
	$main::GlobalValue{NAMESVC} = 'DNS';
  } elsif ( $main::GlobalValue{NAMESVC} == '203') {
	$main::GlobalValue{NAMESVC} = 'NIS';
  }

  return @Ret;
}

# This is a small tool to set a variable to popped value
sub Portset {
   my($What);
   foreach $What (@_) {
     #$main::PortValue{$Port, $What} = pop(@Words);
     $main::PortValue{$Port, $What} = shift(@Words);
     Debug "$Port-$What: ", $main::PortValue{$Port, $What};
   }
}

# This executes the command to get all of the port info for a specific
# port.  It is pretty slow at this point in the game.  Also, some ports
# fail to return info correctly some times, and ports > 9 need to "fail"
# at the end in order to go onto the next command.
sub Who {
  my($WhatPort) = @_;
  my($Pack);

  $WhatPort =~ s/[Ss]//g;
  my($C) = $WhatPort;

  # Port Info
  if ($WhatPort <= 9) { Send "e\0\002" . "$WhatPort" . "\0"; }
  else                { Send "e\0\004" . "$WhatPort" . "\0\0"; }

  $Pack = &SimplePacket;


    if (@Words = &shellwords($Pack)) {
      $Port = $WhatPort;

      # Hey Livingston, what are the Unknowns here?
        Portset PORT, SPEED, DATABITS, STOPBITS, PARITY, CD,
                SAVED_PORT_TYPE, STATUS, DATA_INPUT, DATA_OUTPUT, DATA_PENDING,
                SPEED1, SPEED2, SPEED3, Un14, WELCOME_MESSAGE, PORT_TYPE,
                SAVED_DATA_BITS, SAVED_PARITY, Un19, SAVED_STOP_BITS, Un21, 
                FLOW_CONTROL,
                SAVED_MODEM_CONTROL, 
		RLOGIN_HOST, DEF_HOST, # current and default rlogin host
		Addr7, Addr6, 
                SAVED_LOCAL_IP, TERM,
                PARITY_ERRORS, OVERRUN_ERRORS, FRAMING_ERRORS, AUTOLOG, SEC, 
                Un35,
                LOGIN_PROMPT, LOGIN_SERVICE3, SERVICE_DEVICE, LOGIN_SERVICE,
                CURRENT_LOGIN_SERVICE, SAVED_REMOTE_IP, SAVED_MASK, 
                FRAMED_ADDR, Addr1,
                DEVICE_NAME, Un46, DIALGROUP, MTU, MTU2, Un50, Un51, Un52, 
                Un53,
                ASYNCMAP, Un55, Un56, 
		SAVED_IFILTER, SAVED_OFILTER, # saved input and output filters
		IFILTER, OFILTER, # current input and output filters
                USERNAME,
                IDLE_TIMEOUT, Un63, IDLETIME, STARTTIME, Un66, Un67,
                SPID, DIRECTORY_NUMBER, Un70, Un71, Un72, Un73, Un74, Un75, 
                Un76, JUNK2;  
        }

}

# END Copyright

1;