VMSPerl,
I've come up with a solution to my TCPIP auxiliary service question. I'll
include the code if anyone is interested.
1) I create a server account in UAF with the desired priviledges
2) I create an auxilary service
TCPIP> set service x /protocol=tcp /port={wakeup port #} /proc={process
name}
/user={server_uaf} /file={path}x.com
/log_opt=(file=x.log,all)
3) enable the service
TCPIP> enable service x
4) Place X.COM in SYS$LOGIN for server account
5) Use PerlIDE to open and test the client_oo.pl file
***
Two ports are used on the server side (OpenVMS)
1) wake-up port 2332 (auxilary port defined in TCPIP)
2) communication port 2333
Client attempts to connect to communication port.
If connection fails, then client taps the wake-up port and waits for the
server to start X.COM
Otherwise, X.COM is already running.
Client again connects to communication port if first try is unsuccessful.
Server and Client exchange information with sysread and syswrite
Client tells Server to goodbye or done or shutdown
Server drops the client and may even shutdown. Otherwise server waits for a
new client connection on the communication port 2333.
*** client code ***
#! perl
# require 5.002;
# use strict;
use IO::Socket;
#! use IO::Select;
my ($port);
my ($node);
my $socket;
$node = "a.b.c.d";
$aport = 2332;
$bport = 2333;
#$node = "111.222.333.143";
# Create a socket and wake of server if necessary
if ($socket = create_socket()) {
print "Socket created\r\n";
} else {
exit;
}
#! $socket->autoflush(1);
#! Get welcome message
sysread($socket,$data,1024);
$datalen = length($data);
print "Data of length $datalen received\r\n";
print "$data\r\n";
# communicate with server
$data = xchange($socket, "load\n");
$data = xchange($socket, "save\n");
# $data = xchange($socket, "done\n");
$data = xchange($socket, "shut\n");
# done
close ($socket);
# exchange information between client and server
sub xchange() {
$socket = shift;
$command = shift;
# Send message
print "syswrite: $command\r\n";
syswrite($socket,$command,length($command));
# Get results
sysread($socket,$data,1024);
$datalen = length($data);
print "sysread: $data ($datalen)\r\n";
return $data;
}
# wake up the server on VMS auxilary port
sub wake_up {
$auxilary = IO::Socket::INET->new(PeerAddr => $node,
PeerPort => $aport,
Proto => 'tcp',
Type => SOCK_STREAM)
or print "Could not connect to $node:$aport :$@\r\n";
if (!defined($auxilary)) {
print "Unable to wakeup server\r\n";
return 0;
} else {
print "Waking up server, please wait...\r\n";
sleep(10);
close($auxilary);
return 1;
}
}
# check wake-up socket
# create the data exchange socket and perhaps the wake-up socket
sub create_socket {
$tmp = IO::Socket::INET->new(PeerAddr => $node,
PeerPort => $bport,
Proto => 'tcp',
Type => SOCK_STREAM)
or print "Could not connect to $node:$bport :$@\r\n";
if (!defined($tmp)) {
print "Server not up\r\n";
wake_up();
$tmp = IO::Socket::INET->new(PeerAddr => $node,
PeerPort => $bport,
Proto => 'tcp',
Type => SOCK_STREAM)
or print "Could not connect to $node:$bport :$@\r\n";
if (!defined($tmp)) {
print "Connection error\r\n";
return undef;
} else {
print "Connection successful\r\n";
}
}
return $tmp;
}*** client code ***
*** server code *** X.COM
$ GOTO EOH
Description:
Parameters:
NONE
Logicals:
XXX_MAIL Account name or distribution list, if not defined then MAIL
to current users account.
Return Status:
$EOH:
$ GOSUB INITIAL
$START:
$ IF F$MODE() .EQS. "INTERACTIVE" THEN GOTO INTERACTIVE
$ IF F$MODE() .EQS. "NETWORK" THEN GOTO NETWORK
$ IF F$MODE() .EQS. "BATCH" THEN GOTO BATCH
$ IF F$MODE() .EQS. "OTHER" THEN GOTO OTHER
$ WR " Mode is ''F$MODE()'"
$ !
$ ! Begin of interactive command file.
$ ! Any initialization work
$ !
$INTERACTIVE:
$ WR "Interactive"
$ cre Interactive.
$ GOSUB GO_PERL
$ IF $STATUS.NE.CSR__GOOD THEN GOTO EXIT
$ EXIT:
$ GOSUB CLOSE_DOWN
$ EXIT CSR__STATUS
$NETWORK:
$ show sym perl
$ WR "Network"
$ cre Network.
$ GOSUB GO_PERL
$ GOTO EXIT
$CHECK_P1:
$ IF P1.EQS.""
$ THEN
$ WR "No P1"
$ CSR__STATUS = CSR__ABORT
$ ENDIF
$ RETURN CSR__STATUS
Pre-Menu routine
$INITIAL:
$ CSR__STATUS = %X18008000
$ CSR__GOOD = CSR__STATUS + %X001
$ CSR__ABORT = CSR__STATUS + %X00B
$ CSR__BAD = CSR__STATUS + %X003
$ CSR__STATUS = CSR__GOOD
$ GOSUB SET_WARNING
$ WR := WRITE SYS$OUTPUT
$ _CURRENT = F$ENVIRONMENT("DEFAULT")
$ _PROC = F$ENVIRONMENT("PROCEDURE")
$ _PROC = _PROC - F$PARSE(_PROC,,,"VERSION")
$ _PATH = F$PARSE(_PROC,,,"DEVICE") + F$PARSE(_PROC,,,"DIRECTORY")
$ RETURN CSR__GOOD
Beginning of perl module
$GO_PERL:
$ perl -x SYS$INPUT
$ deck /dollar="__END__"
#! perl
use IO::Socket;
use IO::Select;
#
# A hash of available service routines
#
my %states = (
'load' => \&load,
'save' => \&save,
'shut' => \&shut,
'done' => \&done,
);
my $s;
# Create a socket to listen on.
#
my $listener =
IO::Socket::INET->new( LocalPort => 2333, Listen => 5, Reuse => 1 );
die "Can't create socket for listening: $!" unless $listener;
print "Listening for connections on port 2333\n";
my $readable = IO::Select->new; # Create a new IO::Select object
$readable->add($listener); # Add the listener to it
while(1) {
# Get a list of sockets that are ready to talk to us.
#
my ($ready) = IO::Select->select($readable, undef, undef, undef);
foreach $s (@$ready) {
# Is it a new connection?
#
if($s == $listener) {
# Accept the connection and add it to our readable list.
# Send a welcome message to client
#
my $new_sock = $listener->accept;
$readable->add($new_sock) if $new_sock;
$outline = "Welcome!\n";
syswrite($new_sock,$outline,length($outline));
print "Sent welcome\r\n";
} else { # It's an established connection
$datalen = sysread($s,$command,1024);
print "Got data $command\r\n";
print "Length = $datalen\r\n";
# Was there anyone on the other end?
#
if( defined $datalen && $datalen ne 0) {
# If they said goodbye, close the socket. If not,
# echo what they said to us.
#
if ($command =~ /goodbye/i) {
# say good-bye or use the "shut" or "done" routine
#
$outline = "See you later!\n";
syswrite($s,$outline,length($outline));
$readable->remove($s);
$s->close;
} else {
# Execute the proper server routine
#
switch($s)
}
} else { # The client disconnected.
# No data from client socket
#
$readable->remove($s);
$s->close;
print "Client Connection closed\r\n";
}
}
}
}
# switch between server routines
sub switch {
$s = shift;
print "Switch: $command\r\n";
chop($command);
if (defined($command)) {
if (defined($states{$command})) {
$states{$command}->($s);
} else {
print "Invalid command -$command-\r\n";
print $s "!! Invalid command -$command-\n";
}
} else {
print "No command given";
}
}
# prototype of a "load" command
sub load {
$s = shift;
$response = "!! Processing the load command\n";
syswrite($s, $response, length($response));
}
# prototype of a "save" command
sub save {
$s = shift;
$response = "!! Processing the save command\n";
syswrite($s, $response, length($response));
}
# "done" closes client connect
sub done {
$s = shift;
$response = "!! done\n";
syswrite($s, $response, length($response));
# Finished with the socket
#! $select->remove($s);
#! $s->close;
}
# "shut" closes client connect and server
sub shut {
$s = shift;
$response = "!! shut\n";
syswrite($s, $response, length($response));
# Finished with the socket
#! $select->remove($s);
#! $s->close;
exit
}
sub dummy {
$s = shift;
$response = "Don't just sit there, do something\n";
syswrite($s, $response, length($response));
}
__END__
$ RETURN CSR__STATUS
$ OPEN_ERROR:
$ WR "Open error"
$ CSR__STATUS CSR__ABORT
$ RETURN CSR__STATUS
$ READ_ERROR:
$ WR "Read error"
$ CSR__STATUS CSR__ABORT
$ RETURN CSR__STATUS
Post-Menu Routines
$CLOSE_DOWN:
$ RETURN CSR__GOOD
Begin of batch command file.
$BATCH:
$ WR "Batch"
$ cre Batch.
$ GOTO EXIT
Begin of network command file.
$OTHER:
$ WR "Other"
$ cre Other.
$ GOTO EXIT
Warning handler
$ WARNING:
$ ERR_STATUS = $STATUS
$ IF F$MODE().EQS."BATCH" THEN GOTO BATCH_WARNING
$ !
$ ! Resubmit the error handler.
$ !
$ ON WARNING THEN GOSUB WARNING
$ !
$ ! Place error text into output format.
$ !
$ CHAN := WRITE SYS$OUTPUT
$ GOSUB OUTPUT_WARNING
$ IF $STATUS.EQ.CSR__BAD THEN WRITE SYS$OUTPUT -
"Error -- ''ERR_STATUS'"
$ !
$ ! For interactive sessions prompt for user action.
$ !
$PROMPT:
$ INQUIRE/NOPUNCT ANSWER "[R]estart, [C]ontinue or [A]bort? "
$ IF F$EDIT(ANSWER,"UPCASE") .EQS. "A" THEN GOTO ABORT
$ IF F$EDIT(ANSWER,"UPCASE") .EQS. "C" THEN RETURN CSR__GOOD
$ IF F$EDIT(ANSWER,"UPCASE") .EQS. "R" THEN GOTO START
$ GOTO PROMPT
For BATCH handling of errors. Send message to a mailing list and exit.
$BATCH_WARNING:
$ SET NOON
$ ACCNT = F$TRNLNM("XXX_MAIL")
$ IF ACCNT.EQS."" THEN ACCNT = F$GETJPI("","USERNAME")
$ TEMP_FILE := SYS$LOGIN:TEMP.TXT
$ OPEN/ERROR=NOTEMP/WRITE TEMP 'TEMP_FILE'
$ CHAN := WRITE TEMP
$ GOSUB OUTPUT_WARNING
$ CLOSE TEMP
$ WR " Sending MAIL to ''ACCNT'"
$ MAIL /SUBJECT="Warning message!" 'TEMP_FILE' "''ACCNT'"
$ IF .NOT.$STATUS THEN -
MAIL /SUBJECT="Problem with account ''ACCNT'!" -
'TEMP_FILE' 'F$GETJPI("","USERNAME")'
$ DEL 'TEMP_FILE'.*
$
$ GOTO EXIT
Temporary file unable to open.
$NOTEMP:
$ WR "Can't open error file ''temp_file'"
$ CHAN := WRITE SYS$OUTPUT
$ GOSUB OUTPUT_WARNING
$ GOTO EXIT
Setup an error handler.
$ SET_WARNING:
$ ON WARNING THEN GOSUB WARNING
$ RETURN CSR__GOOD
Output warning message.
$OUTPUT_WARNING:
$ IF F$TYPE(CHAN).EQS."" THEN RETURN CSR__BAD
$ NAME = F$ENVIRONMENT("PROCEDURE")
$ NAME = F$PARSE(NAME,,,"NAME")
$ CHAN " "
$ CHAN "Error in routine ''NAME'"
$ IF F$TYPE(MM).NES."" THEN CHAN MM
$ IF F$TYPE(P1).NES."" THEN CHAN P1
$ CHAN " "
$ CHAN "''F$MESSAGE(ERR_STATUS)'"
$ CHAN " "
$RETURN CSR__GOOD
$ABORT:
$ CSR__STATUS = CSR__ABORT
$ WRITE SYS$OUTPUT "ABORTING..."
$ GOTO EXIT
*** server code ***
*** TCPIP> show service x ***
Service: FCS_SERVICE
State: Enabled
Port: 2332 Protocol: TCP Address: 0.0.0.0
Inactivity: 5 User_name: FCS_SERVER Process: FCS Transfer
Limit: 3 Active: 0 Peak: 3
File: SERVER_OO.COM
Flags: Listen
Socket Opts: Rcheck Scheck
Receive: 0 Send: 0
Log Opts: Acpt Actv Dactv Conn Error Exit Logi Logo Mdfy Rjct TimO Addr
File: SERVER_OO.LOG
TCP options: Delay
Drop_count: 65540 Probe_timer: 0
Security
Reject msg: ! No FCS Service
Accept host: 0.0.0.0
Accept netw: 0.0.0.0
*** TCPIP> show service x ***
