#!/usr/bin/perl -w
#
# FileShare.pm ver 0.9 1-07-03
# Gene Gallistel <gravalo@uwm.edu>
#
#
package FileShare;
use IO::Socket::INET;
use Carp;
use strict;
use vars qw($VERSION);
$VERSION = '0.7';
use vars qw( @ISA @EXPORT );
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( );
## The following is a very basic group of packets.
## These will be used to send and receive commands
## between the client and server.
use vars qw( $M_QUERY $M_ACK $M_REJ );
$M_QUERY = 'b'; # query packet
$M_ACK = 'c'; # acknowledgement packet
$M_REJ = 'd'; # opposite of $M_ACK.
## if $M_REJ is sent to client, it means immediate disconnect. The
## server will not respond to an $M_REJ packet from a client.
## The following is the hash containing constructor elements.
## _send_only - on(1)/off(0) switch, which may seem redundant, since
+one would
## have to choose either server_connection or client_connection, but
+I perfer
## to err on the side of safety.
## _socket - _socket will be an IO::Socket::INET object. Assign a sca
+lar to it.
## I had serious problems with this, setting up this solution for it.
## _directory - dual purpose, for server, the directory which the sha
+red
## files will be stored. For the client, the download directory.
## _debug - on(1)/off(0) switch. If on, will print debugging informat
+ion.
my (%_fields) = ( _send_only => '???', _socket => '???', _directory =
+> '???',
_debug => '???');
my (@_files); # array for files read from directory
my ($files_ref) = \@_files; # reference to point to @_files
my ($directory);
# constructor for object creation
sub new
{
my ($class, %args) = @_;
my ($self) = {%_fields};
foreach my $field (keys %_fields)
{
$self->{$field} = $args{$field}
if defined $args{$field};
}
bless $self, $class;
## assign _directory to the global. This
## will be used in the read_directory sub.
$directory = $self->{_directory};
return $self;
}
# standard destructor
## Will print the nice little message below, then sleep for
## one second, undefine self and exit.
sub DESTROY_SELF
{
my ($self) = shift;
undef %$self;
sleep 1;
croak "\nSELF has been DESTROYED...\n";
}
sub client_connection
{
my ($self, $server, $port, $file) = ($_[0], $_[1], $_[2], $_[3
+] || " ");
my ($file_size, $bytes_read, $data) = 0;
## client must send _send_only to 0, or false
if ($self->{_send_only} ne "0") {
croak "\nClient must set _send_only option to 0";
}
my ($socket) = IO::Socket::INET->new(
PeerAddr => $server,
PeerPort => $port,
Proto => "tcp",
Type => SOCK_STREAM)
or croak "Cannot establish socket connection: $!";
# save socket for later use
$self->{_socket} = $socket;
## if socket is not defined, there is no point in continuing o
+n
if(not defined($socket)) {
croak "\nSocket is not defined in client_connection";
}
## check to confirm file name is not blank
if ($file eq " ") {
croak "\nFile to download is not specified in client_conne
+ction.";
}
## sending query and file name to the server
$self->send_cmd($M_QUERY, $file);
## declare the variables for listening to the server
## and receiving a packet and filename from the server.
+
my ($type, $response);
($type, $response) = $self->recv_cmd;
## first check to confrim packet from server was not a $M_REJ
if ($type eq $M_REJ) {
croak "\nReceived a rejection packet from server";
} elsif ($type eq $M_ACK) {
## If type is equal to M_ACK, a file size should follow.
## After that, the client should open a new file, and
## print until file size has been reached...something
## like that
$file_size = $response;
open (OUTFILE, ">$directory/$file.copy") or croak "Cannot
+open file for writing: $!";
while (read($socket, $data, $file_size)) {
print OUTFILE $data;
$bytes_read += length($data);
## When bytes read is equal to the file's size
## end the read/print loop
if ($bytes_read eq $file_size) {
last;
}
}
close (OUTFILE) or croak "Cannot close file: $!";
## if everything goes well, up to this point,
## file has been downloaded and is now closed.
print STDERR "\nDownloaded $file from server and saved it
+as, $file.copy.\n";
sleep 1; ## sleep for one second
exit 0; ## exit
} else {
## server will never send a $M_QUERY packet,
## so if not the first two, there must be a
## problem.
croak "\nUndetermined packet from server";
}
#return;
}
## Impliments a server connection
sub server_connection
{
my ($self, $port) = ($_[0], $_[1] || "3000");
my ($filename) = " ";
my ($type, $file_size, $number_of_files);
my ($remote, $hostinfo);
my ($data, $buffersize) = 1024;
## This may seem realy redundant, but if someone can
## set up a file server in under 10 lines of code with
## this .pm they should be able to specify the option '1'
## for _send_only
if ( $self->{_send_only} ne "1" ) {
croak "Server dying...variable _send_only must be set to 1
+";
}
# create new socket
my ($socket) = new IO::Socket::INET(
Listen => 10, #could also be SOMAXCONN
LocalPort => $port,
Reuse => 1,
Proto => 'tcp')
or croak "Could not open socket for listening: $!";
## read_directory sub returns an array of files in directory
@{$files_ref} = read_directory();
## used for printing out the files in the $self->{_directory}
+directory
$number_of_files = @{$files_ref};
## print the contents of $self->{_directory} to STDERR,
## so they can be scene while server is engaged.
if ($self->{_debug} eq "1") {
print STDERR "Files to offer: \n";
for (my $i = 0; $i < $number_of_files; ++$i){
print STDERR $files_ref->[$i];
print STDERR "\n";
}
}
while (defined ($remote = $socket->accept)) {
#$remote->autoflush(1);
$hostinfo = gethostbyaddr($remote->peeraddr, AF_INET);
## This was a pain to figure out. Save the
## socket for later. It's changed for because
## of the $socket->accept
$self->{_socket} = $remote;
## Listen for the client to send an $M_QUERY packet
## and a filename.
($type, $filename) = $self->recv_cmd();
## if packet is not $M_QUERY packet (ie. $M_ACK or
## $M_REJ packet) send a $M_REJ packet to the client.
## Then skip to the next iteration of the while loop.
if ($type ne $M_QUERY) {
$self->send_cmd($M_REJ);
next;
}
## If client sends a $M_QUERY packet, determine if file
## exists in $directory and is readable. If not, send
## a response to client.
## Then skip to the next iteration of the while loop.
if ((-e "$directory/$filename") && (-r "$directory/$filena
+me")) {
if ($self->{_debug} eq "1") {
print STDERR "File $filename exists and is readabl
+e\n";
}
## Determine the size of the specified file.
$file_size = (stat("$directory/$filename"))[7];
## Send a $M_ACK packet and a file size
$self->send_cmd($M_ACK, "$file_size");
open (INPUT, "<$directory/$filename") or croak "Cannot
+ open input file $filename: $!";
while (read(INPUT, $data, $file_size)) {
print $remote $data;
}
close (INPUT) or croak "Cannot close input file $filen
+ame: $!";
} else {
## the instance, where the file does not exist or is n
+ot readable
$self->send_cmd($M_REJ); # send rejection to client
next; # skip to next iteration in loop
}
next;
}
}
## Read the list of files into the @_files array for later use.
## The only use for this is for debugging purposes.
sub read_directory
{
my ($self) = $_[0];
my ($dir) = $_[1] || $directory;
my ($file);
opendir(DIR, $dir) or croak "Cannot open directory: $dir : $!"
+;
while (defined ($file = readdir (DIR))) {
## include a check to find '.' directorys
## and jump the the next element
push(@_files, $file);
}
closedir(DIR);
return @_files;
}
## Send a packet over the wire. This should not
## be used by clients/servers directly, but only
## by the send_cmd() sub.
sub _send_packet {
my ($self, $packet) = @_;
my ($socket) = $self->{_socket};
my ($plen) = length($packet); # Size plus null.
# Bounds checking to MAXCHAR-1 (terminating null).
if ($plen > 254) {
croak "send: packet > 255 bytes";
}
# Add the terminating null.
$packet .= "\0"; $plen++;
# Add the packet length (<= 255) to the packet head.
$packet = chr($plen).$packet; $plen++;
my $wrotelen = send($socket, $packet, 0);
if (not defined($wrotelen)) {
croak "send: $!";
} elsif ($wrotelen != $plen) {
croak "send: wrote $wrotelen of $plen: $!";
} else {
return 'ok';
}
return;
}
## Read a pending packet from the socket. This should
## not be used directly by either clients/servers, but
## only by the recv_cmd() sub.
sub _recv_packet {
my ($self) = @_;
my ($socket) = $self->{_socket};
my ($slen, $buffer, $ret);
# Read a byte of packet length.
$ret = recv($socket, $slen, 1, 0);
if (not defined($ret)) {
croak "recv size: $!";
} elsif (length($slen) != 1) {
croak "recv size != 1: $!";
} else {
# Convert char to integer.
$slen = ord($slen);
while ($slen) { # Read the entire packet.
my $pbuf;
$ret = recv($socket, $pbuf, $slen, 0);
if (not defined($ret)) {
croak "recv msg: $!";
} else {
$slen -= length($pbuf);
$buffer .= $pbuf;
}
}
# Remove trailing null.
chop($buffer);
return($buffer);
}
return;
}
# Read a message from the server and break it into its fields.
sub recv_cmd {
my ($self) = shift;
my ($msg);
# Read the waiting packet.
if (eval { $msg = $self->_recv_packet() }) {
# Break up the message.
my ($type, $buf) = split(/,/, $msg);
## if debugging set, print packet type and buffer
if ($self->{_debug} eq "1") {
print STDERR "\nReceiving Packet Type: $type\nReceivin
+g Buffer: $buf\n";
}
return ($type, $buf);
}
return;
}
sub send_cmd
{
if (@_ > 2) {
my ($self, $cmd, $data) = @_;
## $cmd will be either $M_QUERY, $M_ACK, or $M_REJ
## The first two will have a second scalar with them.
## $M_REJ is the equivalent of a kill packet to client.
## Server will not respond to the $M_REJ packet.
## printing options if debugging option set
if ($self->{_debug} eq "1") {
print STDERR "\nSending Command: $cmd\nSending Data: $
+data\n";
}
my ($buf) = "$cmd,$data";
if (eval { $self->_send_packet($buf) }) {
return 'ok';
}
} else {
my ($self, $cmd) = @_;
my ($buf) = "$cmd,";
## again, printing $cmd if debugging is set to 1
if ($self->{_debug} eq "1") {
print STDERR "\nSending Command: $cmd\n";
}
if (eval { $self->_send_packet($buf) }) {
return 'ok';
}
}
}
1;
|