#!/usr/bin/perl -w
#
# rrlogin - RoadRunner (Hawaii Only) Login Client
#
# $Id: rrlogin.pl,v 0.1 1998/01/29 21:03:25 edo Exp $
#
# Copyright (c) 1998 Ed Orcutt <edo@eosys.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

require 5.002;
use strict;
use Socket;
use MD5;	#  Perl interface to MD5 Message-Digest Algorithm

my ($username, $password, $Verbose);

# ------------------------------------------------------------------------
# CHANGE the username and password!!!

$username   = "usernamegoeshere";	# RoadRunner username
$password   = "passwordgoeshere";	# RoadRunner password in lowercase ;-)
$Verbose    = 1;		# Print debugging messages if set

# ------------------------------------------------------------------------
# You really DO NOT want to change any of the values below
# unless you REALLY know what you are doing.

my ($Version_ID, $OS_ID, $OS_Version);
my ($protocol, $port, $remote, $iaddr, $paddr);
my ($parameters, $message, $bytes, $reply);
my ($MsgType, $MsgLen, $Session_ID);
my ($HashPwd, $Nonce);
my ($Pwd, $Blinding, $Credentials);

sub LoginResponse;

$Version_ID = 10;
$OS_ID      = "Windows NT";

$port       = 60000;		# TCP port for login/logout
$remote     = "sms1.hawaii.rr.com";		# Session Management Server

$OS_Version = "4.0";		# Modified to tell NT Version 

# ------------------------------------------------------------------------
# Establish a connection to the Session Mgt Server port 60000/tcp

$protocol = getprotobyname('tcp');
$iaddr = inet_aton($remote) || die "no host: $remote";

$paddr = sockaddr_in($port, $iaddr);

socket(SOCK, AF_INET, SOCK_STREAM, $protocol) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";

# ------------------------------------------------------------------------
# We're connected, now build and send a "Login Request" message

$parameters = (pack "nn",  7, length($username)+4) . $username .
              (pack "nnn", 3, 6, $Version_ID) .
              (pack "nn",  4, length($OS_ID)+4) . $OS_ID .
              (pack "nn",  5, length($OS_Version)+4) . $OS_Version .
              (pack "nnn", 6, 6, 0) .
              (pack "nnn", 8, 6, 7777);

$message = (pack "nnN", 3, length($parameters)+8, 0) . $parameters;

$Verbose && print "Sending Login Request ...\n";
syswrite(SOCK, $message, length($message));

# ------------------------------------------------------------------------
# Read the response to our "Login Request"

$bytes = sysread(SOCK, $reply, 1024);

if ($bytes == 0) {
    $Verbose && print "No reply to our request, exiting!\n";
    exit 1;
}

# Decode the message type, length and session id

($MsgType, $MsgLen, $Session_ID) = unpack "nnN", substr($reply, 0, 8);
$Verbose && print "Received message type $MsgType, length $MsgLen, bytes $bytes\n";

# We should have gotten an "Authenticate Response" message in reply.
# Unless the Username is not valid, and we get a "Login Response".

if ($MsgType == 5) {
    LoginResponse($reply);
    exit 3;
} elsif ($MsgType != 9) {
    $Verbose && print "Authenticate Response expected, but got message type $MsgType instead, exiting!\n";
    exit 2;
}

# ------------------------------------------------------------------------
# Unpack the "Authenticate Response" message parameters

$HashPwd = unpack "n", substr($reply, 12, 2);
$Nonce = substr($reply, 18, 16);

# ------------------------------------------------------------------------
# Build and send a "Authenticate-Login Request" message

$Pwd = $HashPwd ? MD5->hash($password) : $password;
$Blinding = (pack "N", time());
$MsgType = (pack "n", 4);
$Credentials = MD5->hash($Nonce . $Pwd . $Blinding . $MsgType);

$message = (pack "nnN",  4, 36, 0) .
           (pack "nn",  11, 20)    . $Credentials .
           (pack "nn",  21,  8)    . $Blinding;

$Verbose && print "Sending Authenticate-Login Request ...\n";
syswrite(SOCK, $message, length($message));

# ------------------------------------------------------------------------
# Read the response to our "Authenticate-Login Request"

$bytes = sysread(SOCK, $reply, 1024);
if ($bytes == 0) {
    $Verbose && print "No reply to our request, exiting!\n";
    exit 1;
}

# Decode the message type, length and session id

($MsgType, $MsgLen, $Session_ID) = unpack "nnN", substr($reply, 0, 8);
$Verbose && print "Received message type $MsgType, length $MsgLen, bytes $bytes\n";

# We should have gotten a "Login Response" message in reply

if ($MsgType != 5) {
    $Verbose && print "Login Response expected, but got message type $MsgType instead, exiting!\n";
    exit 1;
}

LoginResponse($reply);

# ------------------------------------------------------------------------
# Close the connection to the Session Mgt Server

close(SOCK) || die "close: $!";

exit 1;

# ------------------------------------------------------------------------
# Decode a "Login Response" message

sub LoginResponse {
    my $msg = shift;
    my ($StatusCode, $ParamType, $ParamLen);

    # Unpack the "Status Code" parameter

    $StatusCode = unpack "n", substr($msg, 12, 2);

    if    ($StatusCode ==   0) { print "Login Successful!\n"; }
    elsif ($StatusCode ==   1) { print "Username was not found.\n"; }
    elsif ($StatusCode ==   2) { print "Password was incorrect.\n"; }
    elsif ($StatusCode ==   3) { print "Your account is disabled.\n"; }
    elsif ($StatusCode ==   4) { print "You have been disabled?\n"; }
    elsif ($StatusCode == 100) { print "Login Successful, but you are already logged in.\n"; }
    elsif ($StatusCode == 101) { print "Login Authenticate retry limit exceeded.\n"; }
    elsif ($StatusCode == 102) { print "Login Successful! But client software is out of date?\n"; }
    elsif ($StatusCode == 103) { print "Login Failed! Client software version is invalid.\n"; }
    elsif ($StatusCode == 500) { print "Server unknown error ;-)\n"; }
    elsif ($StatusCode == 501) { print "Server unable to perform username validation.\n"; }
    elsif ($StatusCode == 502) { print "Server unable to perform password validation.\n"; }
    else                       { print "Unknown Status code???\n"; }

    # Was there any "Response Text"? If so, print it

    ($ParamType, $ParamLen) = unpack "nn", substr($msg, 14, 4);

    if ($ParamType == 9) {
	print "Response Text: " . substr($msg, 18, $ParamLen) . "\n";
    }
}