package portmaster;

# 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 (I have this file in a hard to locate
# and 'C' wrapped location) or specify it in any
# of the programs from the command line.
$main::Password = 'yourmamma';

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

# set this to the names of all your portmasters
# it is used by programs that query multiple pm's
@main::All = ("pm2.nowhere.com","pm3.nowhere.com","pm4.nowhere.com", "pm5.nowhere.com");

# 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=('gem','televid','msn', 'PP', 'PPP');

# end of (most) site dependent variables

require 'shellwords.pl';

##use strict;  ## for debugging
use Socket;

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


#---------------------------------------------------------------------------- 
# 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) = "";
   
  # Magicall Check for data
  # This really does not NEED to be here, we only ask for
  # data when we want data, but....

  my($ReadBits, $Found, $Dev);
  $ReadBits = '';
  vec($ReadBits, fileno(main::DS), 1) = 1;
  $Found = select($Dev = $ReadBits, undef, undef, 1);
  if ($Found == -1) {
    Debug "NO DATA FOUND on Call from ", caller;
  } else {
    $Data = recv(main::DS, $Line, $Count, 0);
    Debug "Read: ($Data) $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
  my($Response) = Get 4;
  # The last by is the number of chars remaining
  # Unless we want lots' o data (tm)
Debug "Response: $Response";
  if (substr($Response, -1, 1) eq "\0") {
    $Response = Get 500;

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

  } else {
    my($Count) = unpack('C1', substr($Response, -1, 1))+1;
    $Count += unpack('C1', substr($Response, -2, 1)) * 256;
Debug "Count: $Count";
    $Response = Get $Count;
  }
  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";
  $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";
  $Resp = &SimplePacket;
  if ($Resp eq "s") {
     Debug "Login Sucessfull.";
  } 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
  $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

  $File = "routes"; 

  Send "e\0" . pack(C, length($File)+1) . $File . "\0\0";
  #my $Resp = Get 16;
  $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";
  $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 {
   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
    Send "e\0\002" . "$WhatPort" . "\0";
    #$Pack = Get 2000;
    $Pack = SimplePacket;


    if (eval q{@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;  
        }

    if ($WhatPort > 9) {
      Send "\e\0
\0";
      $Port = &Get(40);
    }

}

# END Copyright

1;