package upftp;
# Ղ낾FTP[h(PASSIVE[h)
# by ڂ<zurubon@lycos.ne.jp>
  $version = 'upftp.pl,v 1.0 2001/08/26 08:58:00 zurubon';
# 
# g
# require './upftp.pl';
# &upftp::login($host, $port, $user, $pass);
# &upftp::cd($dir);
# &upftp::upload($file);
# &upftp::del($file);
# &upftp::logout;

use Socket;
use FileHandle;

sub login{
	($host, $port, $user, $pass) = @_;

	$port = getservbyname('ftp', 'tcp') if(!$port);
	$comd = new FileHandle;

	# open
	&ftp_open($comd, $host, $port);
	&recv_msg($comd);

	# F
	&send_msg($comd, "USER $user");
	&recv_msg($comd);
	&send_msg($comd, "PASS $pass");
	&recv_msg($comd);
}

sub cd{
	my $dir = shift;
	# CWD
	&cwd($comd, $dir);
}

sub upload{
	my $file = shift;
	# binary mode
	&type($comd, "b");
	# PASV & file upload.
	&put($comd, $file);
}

sub del{
	my $file = shift;
	# DELE
	&dele($comd, $file);
}

sub logout{
	# QUIT
	&quit($comd);
	# I
	close $comd;
}

sub ftp_open{
	my ($sock, $host, $port) = @_;
	my $ip, $sockaddr;

	# make socket & open connection
	$ip = inet_aton($host) || die "host not found.\n";
	$sockaddr = pack_sockaddr_in($port, $ip);
	socket($sock, PF_INET, SOCK_STREAM, 0) || die "socket error.\n";
	connect($sock, $sockaddr) || die "connect error.\n";
	autoflush $sock (1); # autoflush mode
}

sub send_msg{
	my ($sock, $command) = @_;

	print $sock "$command\n";
}

sub recv_msg{
	my $sock = shift;
	my $buf, $rc, $cont, $msg;

	$rc = 0;
	while (chomp($buf=<$sock>)){
		$buf =~ /^(\d\d\d)([ |-])(.*)/;
		$rc = $1; $cont=$2; $msg=$3;
		last if($cont ne '-');
	}
#	print "$buf\n"; # for debug use.
	return $buf;
}

# passive|[ǧvZ
sub get_pasv_port {
	my $buf = shift;
	my $host, $port;

	$buf =~ /^2\d\d .*\((\d+,\d+,\d+,\d+),(\d+),(\d+)\)/;
	$host = $1;
	$port = $2 * 256 + $3;
	$host =~ s/,/\./g;
	return($host, $port);
}

# JgfBNgύX
sub cwd{
	my ($sock, $dir) = @_;
	my $buf;

	&send_msg($sock, "CWD $dir");
	$buf = &recv_msg($sock);
	return $buf;
}

sub type{
	my ($sock, $type) = @_;
	my $buf;

	if($type =~ /^(B|b)/){
		&send_msg($sock, "TYPE I");
	}
	elsif($type =~ /^(A|a)/){
		&send_msg($sock, "TYPE A");
	}
	else{
		return 0;
	}
	$buf = &recv_msg($sock);
	return $buf;
}

sub dele{
	my ($sock, $file) = @_;

	print $sock "DELE $file\n";
	$buf = &recv_msg($sock);
	return $buf;
}

sub put{
	my ($sock, $file) = @_;
	my $buf, $pid, $data, $host, $port;

	&send_msg($sock, "PASV");
	($host, $port) = &get_pasv_port(&recv_msg($sock));

	&send_msg($sock, "STOR $file");
	if ($pid = fork()) {
		$buf = &recv_msg($sock);
		if ($buf =~ /^5/) { kill 'TERM', $pid; return; }
		wait;
		$buf = &recv_msg($sock);
	}
	else{
		$data = new FileHandle;
		&ftp_open($data, $host, $port);
		open(UP_FILE, "$file") || exit(1);
		binmode (UP_FILE);
		while(<UP_FILE>) {
			print $data $_;
		}
		close(UP_FILE);
		close($data);
		exit(0);
	}
}

sub quit{
	my $sock = shift;

	print $sock "QUIT\n";
	$buf = &recv_msg($sock);
	return $buf;
}

1;
