 |
 |
 |
|
|
|
#tcp-client
( $them, $port ) = @ARGV;
$port = 23 unless $port;
$them = 'localhost' unless $them;
$AF_INET = 2;
$SOCK_STREAM = 1;
$SIG{'INT'} = 'dokill';
sub dokill {
kill 9,$child if $child;
}
$sockaddr = 'S n a4 x8';
#chop($hostname = `hostname`);
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thisaddr) =
gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);
if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
print "socket ok\n";
}
else {
die $!;
}
if (bind(S, $this)) {
print "bind ok\n";
}
else {
die $!;
}
if (connect(S,$that)) {
print "connect ok\n";
}
else {
die $!;
}
select(S); $| = 1; select(STDOUT);
$a=<S>;print "$a";
while( $b=<STDIN> ) {
print S "$b\n";
$a=<S>;print "$a";
}
exit 1 ;
This script gets from host arg1 the page specified by arg2
# #!/usr/local/bin/perl -w
die "Usage $0 host page \n" if $#ARGV <1;
print "Content-type: text/html\n\n";
print &GetHTTP($ARGV[0],$ARGV[1]);
exit 0;
sub GetHTTP {
use Socket;
my($remote,$doc) = @_;
my ($port, $iaddr, $paddr, $proto, $line,@output);
$port = 80;
$sockaddr = 'S n a4 x8';
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$thisaddr = gethostbyname("localhost");
$thataddr = gethostbyname($remote);
$this = pack($sockaddr, AF_INET, 0, $thisaddr);
$that = pack($sockaddr, AF_INET, $port, $thataddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
bind(SOCK, $this) || die "bind: $!";
connect(SOCK, $that) || die "connect: $!";
select(SOCK); $| = 1; select(STDOUT);
print SOCK "GET $doc HTTP/1.0\n\n";
do {
$line = <SOCK>
} until ($line =~ /^\r\n/);
@output = <SOCK>;
close (SOCK) || die "close: $!";
@output;
}
#!/usr/local/bin/perl
#
# test_ftp - simple test of sock.pl and ftp.pl
#
# This opens a telnet connection, attempts to log in as "nobody" with a
# bad password, then leaves the telnet session by sending a CTRL-D.
# The prompt strings are those of a Sun, so you may have to change these.
#
#############################################################################
require 'sock.pl';
require 'telnet.pl';
# routine for clean shutdown on error
sub abort {
&sock'close_all;
die "ended unexpectedly, but shut down cleanly\n";
}
$hostname = "robinsc.tcs.tandem.com";
$port = "21";
$timeout = 1;
$login_prompt = '220 ';
$login_prompt2 = '230 ';
$password_prompt = '331 Give me your password, please';
#############################################################################
#
# Open the connection
#
$session = &sock'open($hostname,$port) || die $!;
#############################################################################
#
# Get to the login prompt
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
last if m/$login_prompt/g;
print;
}
print "got login prompt";
print $session "user anonymous\n"; # send a login name
print "passsword now\n";
#############################################################################
#
# Get the password prompt
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
print;
last if m/$password_prompt/gio;
}
print $session "pass Psycho\n"; # send a password
#############################################################################
#
# Get the next login prompt, since the last one one should have failed
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
print;
print $session "quit\n";
last if m/$login_prompt2/o;
}
#print $session "\004"; # CTRL-D to abort the telnet session
#############################################################################
#
# Get any exit messages
#
until (&telnet'eof) {
print &telnet'read($session, $timeout);
}
print "\ntest completed\n";
&sock'close($session);
exit (0);
#!/usr/local/bin/perl
package sock;
;# USAGE:
;# ======
;#
;# To open a connection to a socket:
;#
;# $handle = &sock'open($hostname, $port) || die $!;
;# # hostname & port can each be either a name or a number
;#
;# Read and write the same as with any other file handle:
;#
;# print $handle "hello, socket\n";
;# $response = <$handle>;
;#
;# To close cleanly:
;#
;# &sock'close($handle);
;#
;# To close all open sockets, in case of an emergency exit:
;#
;# &sock'close_all;
;#
;# AUTHOR: David Noble (dnoble@ufo.jpl.nasa.gov)
;# DATE: 11 Feb 1993
;#
;# Modify and use as you see fit, but please leave my name on
;# it as long as it still resembles the original code.
;#
;#############################################################################
;# Get system-specific socket parameters, make assumptions if necessary.
$sockaddr_t = 'S n a4 x8';
eval "require 'sys/socket.ph'";
eval <<'END_SOCKET_DEFINITIONS' if $@;
sub AF_INET { 2; }
sub SOCK_STREAM { 1; }
sub SOL_SOCKET { 65535; }
sub SO_REUSEADDR { 4; }
END_SOCKET_DEFINITIONS
;# Seed the generation of names for file handles.
$latest_handle = 'sock0000000001';
sub open {
local ($remote_host, $remote_port) = @_;
if (!$remote_port) {
$! = "bad arguments to sock'open()";
return 0;
}
$sock = ++$latest_handle;
;# Look up the port if it was specified by name instead of by number.
if ($remote_port =~ /\D/o) {
($name,$aliases,$remote_port) = getservbyname($remote_port,'tcp');
}
;# Look up the address if it was specified by name instead of by number.
if ($remote_host =~ /\D/o) {
($name,$aliases,$type,$len,$remote_addr) = gethostbyname($remote_host);
} else {
$remote_addr = $remote_host;
}
;# Make the socket structures.
$this = pack($sockaddr_t, &AF_INET, 0, "\0\0\0\0");
$remote_sock = pack($sockaddr_t, &AF_INET, $remote_port, $remote_addr);
;# Make the socket filehandle.
($name,$aliases,$proto) = getprotobyname('tcp');
socket($sock, &AF_INET, &SOCK_STREAM, $proto) || return 0;
;# Set up the port so it's freed as soon as we're done.
setsockopt($sock, &SOL_SOCKET, &SO_REUSEADDR, 1);
;# Bind this socket to an address.
bind($sock, $this) || return 0;
;# Call up the remote socket.
connect($sock,$remote_sock) || return 0;
$handles{$sock} = 1;
$oldfh = select($sock); $| = 1; select($oldfh);
return "sock'" . $sock;
}
sub close {
local ($sock) = shift(@_) || return 0;
shutdown ($sock, 2);
delete $handles{$sock};
}
sub close_all {
for $sock (keys %handles) {
shutdown ($sock, 2);
delete $handles{$sock};
}
}
#!/usr/local/bin/perl
package telnet;
;# USAGE:
;# ======
;#
;# $buffer = &telnet'read($handle, $timeout);
;#
;# INPUTS:
;#
;# $handle - regular file handle returned by opening the socket
;# $timeout - number of seconds to wait before returning empty-handed
;#
;# RETURN VALUE:
;#
;# Returns data from the socket after removing the garbage from telnet
;# handshaking. If there is no multiline pattern matching, ie: ($* == 0),
;# then only one line at a time is returned. The remaining lines are buffered
;# in the package, and will be used to satisfy further requests for data until
;# the buffer is empty again. A partial line may be returned if the timeout
;# was reached before a newline. On the other hand, when multiline pattern
;# matching is on ($* == 1), all the available data is returned.
;#
;# Returns the empty string on EOF or timeout.
;# To decide which it was, use these functions:
;#
;# if ( &telnet'eof ) { &outta_here; }
;# if ( &telnet'timeout ) { &whatever; }
;# if ( &telnet'ok ) { &data_received; }
;#
;# AUTHOR: David Noble (dnoble@ufo.jpl.nasa.gov)
;# DATE: 11 Feb 1993
;#
;# Modify and use as you see fit, but please leave my name on
;# it as long as it still resembles the original code.
;#
;#############################################################################
$status = 'ok';
sub read {
local ($handle) = shift (@_);
local ($endtime) = shift (@_);
local ($rmask, $nfound, $nread, $thisbuf);
local ($multilines) = $*;
local ($buf) == '';
$status = 'ok';
$* = 1; # this gets restored to its previous value before returning
if (!$TelnetBuffer{$handle}) {
$endtime += time;
get_data: while ($endtime > time) {
$rmask = "";
$thisbuf = "";
vec($rmask, fileno($handle), 1) = 1;
($nfound, $rmask) = select($rmask, "","", $endtime - time);
if ($nfound) {
$nread = sysread($handle, $thisbuf, 1024);
if ($nread > 0) {
$TelnetBuffer{$handle} .= $thisbuf;
last get_data if &_preprocess($handle) && !$multilines;
}
else {
$status = 'eof';
return ''; # connection closed
}
}
else {
$status = 'timeout';
last get_data;
}
}
}
if ($TelnetBuffer{$handle}) {
if (!$multilines && ($TelnetBuffer{$handle} =~ m/\n/o)) {
$TelnetBuffer{$handle} =~ s/^(.*\n)//o;
$buf = $1;
}
else {
$buf = $TelnetBuffer{$handle};
$TelnetBuffer{$handle} = '';
}
}
$* = $multilines;
$buf;
}
sub ok { $status eq 'ok'; }
sub eof { $status eq 'eof'; }
sub timeout { $status eq 'timeout'; }
sub status { $status; }
sub _preprocess {
local ($handle) = shift(@_);
local ($_) = $TelnetBuffer{$handle};
s/\015\012/\012/go; # combine (CR NL) into NL
while (m/\377/o) {
# respond to "IAC DO x" or "IAC DON'T x" with "IAC WON'T x"
if (s/([^\377])?\377[\375\376](.|\n)/\1/o)
{ print $handle "\377\374$2"; }
# ignore "IAC WILL x" or "IAC WON'T x"
elsif (s/([^\377])?\377[\373\374](.|\n)/\1/o) {;}
# respond to "IAC AYT" (are you there)
elsif (s/([^\377])?\377\366/\1/o)
{ print $handle "nobody here but us pigeons\n"; }
else { last; }
}
s/\377\377/\377/go; # handle escaped IAC characters
$TelnetBuffer{$handle} = $_;
m/\n/o; # return value: whether there is a full line or not
}
;# For those who are curious, here are some of the special characters
;# interpretted by the telnet protocol:
;# Name Dec. Octal Description
;# ---- ---- ----- -----------
;# IAC 255 \377 /* interpret as command: */
;# DONT 254 \376 /* you are not to use option */
;# DO 253 \375 /* please, you use option */
;# WONT 252 \374 /* I won't use option */
;# WILL 251 \373 /* I will use option */
;# SB 250 \372 /* interpret as subnegotiation */
;# GA 249 \371 /* you may reverse the line */
;# EL 248 \370 /* erase the current line */
;# EC 247 \367 /* erase the current character */
;# AYT 246 \366 /* are you there */
;# AO 245 \365 /* abort output--but let prog finish */
;# IP 244 \364 /* interrupt process--permanently */
;# BREAK 243 \363 /* break */
;# DM 242 \362 /* data mark--for connect. cleaning */
;# NOP 241 \361 /* nop */
;# SE 240 \360 /* end sub negotiation */
;# EOR 239 \357 /* end of record (transparent mode) */
1;
require "ftp.pl";
local($connect);
print"\nftp>";
$connect=0;
$login=0;
$debug=0;
Loop:
while(chop($a=<STDIN>))
{
next Loop if (!(length $a));
@a=split (' ',$a);
if ($a[0]=~/open/i) #OPEN
{
if (!$connect)
{
if(defined $a[1])
{
print "connecting to $a[1]\n";
$result=&ftp'open($a[1],21,0,2);
if ($result)
{
print "Connected\n";
$connect=1;
print"Login:";chop($user=<STDIN>);
print"Password:";chop($pass=<STDIN>);
$result=&ftp'login($user,$pass);
if ($result) {$login=1;print "$ftp'response\n";}
else {print"Login failed.$ftp'response\n"; next Loop;}
}else {print"Connect failed\n"; next Loop;}
}else {print"You must specify a hostname\n"; next Loop;}
}else {print "Already connected use close first.\n"; next Loop;}
}
if($a[0]=~/debug|hash|verbose/i ) #DEBUG HASH VERBOSE
{
$debug=!$debug;
$out='on';$debug||($out='off');
print"Debugging now $out\n";
ftp'debug($debug);
next Loop;
}
if ($a[0]=~/quit|bye|exit/i) #QUIT BYE EXIT
{
if ($connect)
{
&ftp'close;
print"Connection closed\n";
}
else { print"exiting ...\n"; }
last Loop;
}
next Loop if (!$connect);
if ($a[0]=~/user/i) #USER
{
if(!$a[1]) {print "Username must be specified\n";next Loop;};
print"Password:";chop($pass=<STDIN>);
$result=&ftp'login($a[1],$pass);
if ($result) {$login=1;print "$ftp'response\n";}
else {print"Login failed.$ftp'response\n"; next Loop;}
}
if ($a[0]=~/close/i) #CLOSE
{
if ($connect)
{
&ftp'close;
print"Connection closed\n";
$login=0;$connect=0;
next Loop;
}
else {print"Sorry not connected and \n"}
}
if (!$login)
{
print "Not Logged in yet\n";
next Loop;
}
if ($a[0]=~/ls|dir/i) #LS OR DIR
{
shift @a;
$a= join(' ',@a);
$result=&ftp'dir_open($a);
if ($result)
{
while(<ftp'NS>){print;}
}
&ftp'dir_close;
}
if($a[0]=~/quote/i) #QUOTE
{
shift @a;
$a= join(' ',@a);
if ($a!~/list|retr/)
{
$result=&ftp'quote($a);
print"resp> $ftp'response";
}
}
if($a[0]=~/cd|cwd/i) #CWD CD
{
$result= &ftp'cwd($a[1]);
# print "Current directory now $a[1]\n" if(!$result);
print"$ftp'response\n";
}
}
continue
{
print "ftp>";
}
#!/usr/local/bin/perl
#
# test_telnet - simple test of sock.pl and telnet.pl
#
#
#############################################################################
require 'sock.pl';
require 'telnet.pl';
# routine for clean shutdown on error
sub abort {
&sock'close_all;
die "Connection closed by foreign host\n";
}
if (defined $ARGV[0]) {$hostname =$ARGV[0] ;}
else {
$hostname = "robinsc.tcs.tandem.com"; }
$port = "21";
$timeout = 1;
#############################################################################
#
# Open the connection
#
$session = &sock'open($hostname,$port) || die $!;
#############################################################################
#
# Get to the login prompt
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
last if (length $_ ==0);
#m/$login_prompt/g;
print;
}
print "got login prompt";
print $session "user anonymous\n"; # send a login name
print "passsword now\n";
#############################################################################
#
# Get the password prompt
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
print;
last if (length $_ ==0);
#last if m/$password_prompt/gio;
}
print $session "pass Psycho\n"; # send a password
#############################################################################
#
# Get the next login prompt, since the last one one should have failed
#
while (1) {
$_ = &telnet'read($session, $timeout);
&abort if &telnet'eof;
print;
if (length $_ ==0)
{
print"ftp>";
$a=<STDIN>;
print $session "$a";
}
}
#############################################################################
#
# Get any exit messages
#
until (&telnet'eof) {
print &telnet'read($session, $timeout);
}
print "\ntest completed\n";
&sock'close($session);
exit (0);
require "ftp.pl";
ftp'open(localhost,21,3,3);
ftp'login(anonymous,temp);
local( $remote_user, $remote_password ) = @_;
$a=&ftp'pwd;
ftp'cwd("c:\\incoming\\");
print "current working dir $a\n";
$a=&ftp'pwd;
print "current working dir $a\n";
$b=&ftp'dir_open;
while(<ftp'NS>)
{
print ;
}
&ftp'dir_close;
print"getting file\n";
ftp'get("tst.txt","",0);
system("type tst.txt");
ftp'close;
# local( $site, $ftp_port, $retry_call, $attempts ) = @_;
Copyright © Robin S. Chatterjee. All rights reserved.
|
|
|
This page hosted by 
Get your own Free Home Page