% Dave started the framework for this one.
% Filled in by me (Stan)
% Starting the idea of an action (resp->func)[,(resp->func)] list
% sort of protocol state-machine...
% Really, this is a 1st pass on an idea I've had in the back of my mind:
% Like a protocol interpreter to make the TCP protocols
% easy to implement given an LR(1) grammar with production descriptions.

% initialized in init.sl:
%ftp_dir = sprintf("%s/dl/", getenv("HOME"));
variable ftpRblok = 1024;

typedef struct {
	code,
	func
%	rmrk
} FTPmach_Type;

% the FTP_Type structures which hold info about TCP connections
% to FTP servers.  In comments below,
%   C means a control connection, (usually server port 21)
%   L is a socket listening for a data connection, (which then becomes)
%   D an accepted data connection, (usually server port 20).
%
typedef struct {
	sock,  % C L D local socket vfd
	other, % C L=D C-socket <--> (L/D) socket
  type,  % C L D type (C|L|D)(R|S), R=recv, S=send
	host,  % C=L=D name of ftp-server
	port,  %   L   local port# of L
	dir,   % C=L=D dir of remote
	file,  % C=L=D name of remote file
	lfile, % C=L=D full pathname of local file
	lvf,   % C=L=D local file's vfd (file opened by C, closed by D)
	size,  % C L D size of file, if known, o/w -1
	count, %     D bytes xfer'd so far, only D increments.
	mach,  % C     'state-machine'
	time0, % C L D when socket opened
	time,  % C L D last activity (but L,D update C also)
	multi, % C     prefix response to wait for in case multi-line response
	meter  %   L D progress-meter (could be set before L becomes D)
} FTP_Type;

% {{{ this is just for debug:
define cmdftpl(p,i)
{
	variable v = p.v;
	variable s = string(vf_fileno(v.sock));
	variable u = v.other;
	variable o = "*"; if (u != NULL)	o = string(vf_fileno(u.sock));
	variable so = sprintf("(%s,%s)",s,o);
	variable l = "*"; if (v.lvf != NULL)	l = string(vf_fileno(v.lvf));
	variable ty = v.type;
  variable url = sprintf("%s:%d%s/%s",v.host,v.port,v.dir,v.file);
	irc_Logf("FTP %2d %-3s %-9s %-3s %-40s (%d)",
	                i,  ty,  so,   l,  url, unix_time - v.time);
}

define cmd_FTP_LIST(stuff)
{
	s_dofunc(ftp_list,&cmdftpl);
}
% }}}

define machpush(mach,code,funcref)
{
	variable m = @FTPmach_Type;
	m.code = code;
	m.func = funcref;
	() = s_put1st(mach,m);
}

define ftp_writes(sock,s)
{
	variable w,n;
	n = strlen(s);
	irc_Logf("[FTP]>%s",s);
	w = vf_write(sock,s);
	if (w == n) return;
  irc_Logf("incomplete ftp write: %d/%d",w,n);
}

define Fs_cmp(ftp,sock) { return(ftp.sock == sock); }

define find_ftp(sock)
{
	variable p = s_find_n1(ftp_list.f,&Fs_cmp,sock);
	if (p != NULL) return p;
	irc_Logf("$ ftp(%d) not in ftp_list",vf_fileno(sock));
	() = clr_action(sock);
	return NULL;
}

define Hs_cmp(ftp,host)
{
	if (ftp.host != host) return 0;
	if (ftp.type[2] != '2') return 0;
	if (ftp.type[0] != 'C') return 0;
	return (ftp.other == NULL);
}


% this terminates and deletes a D or L type connection
define ftp_kill_data(p)
{
	variable dftp = p.v;
	variable typ0,sz,t,c,r = 0;
	variable rvf,wvf;

	t = 0.5 + (unix_time - dftp.time0);
	typ0 = dftp.type[0];
	irc_Logf("[FTP] Closing (%s) data connection: %s",dftp.type,dftp.host);
	() = clr_action(dftp.sock);
	irc_destroy_pm(dftp.meter);
	if (typ0 == 'D') {
		sz = sprintf("%d",dftp.count);
		if (dftp.size != -1) { % size known
			if (dftp.count != dftp.size) sz = sprintf("%s of %d",sz,dftp.size);
		}else{
			sz = sz + " of ???";
		}
		irc_Logf("[FTP] [%s] %s bytes in %.1f secs (%.0f/sec)",
			       dftp.file, sz, t, dftp.count / t);
	}

	if (dftp.lvf != NULL) {
		if (dftp.type[1] == 'S')
			(rvf,wvf) = (dftp.lvf,dftp.sock);
		else
			(rvf,wvf) = (dftp.sock,dftp.lvf);

		() = clr_action(wvf);
		if (dftp.type[0] == 'D')
			r = set_wrdep(wvf,rvf,0);
		if (r)
			irc_Logf("[FTP] clr_wrdep(lvf,sock) failed: %d",r);
		else {
			c = vf_close(dftp.lvf);
			if(c) irc_Logf("[FTP] close(lvf) %d",c);
			dftp.lvf = NULL;
		}
	}else{
		irc_log("[FTP] dftp.lvf == NULL (??)");
		r = -1;
	}
	!if (r) {
		c = vf_close(dftp.sock);
		if(c) irc_Logf("[FTP] close(dftp.sock) %d",c);
	}
	dftp.other.other = NULL;
	s_del(p);
}

define ftp_kill(cftp, ret, message)
{
	variable c,p,q,dftp;
	irc_Logf("[FTP] killing: %d %s",ret,message);
	p = find_ftp(cftp.sock);
	if (p == NULL) return;
	() = clr_action(cftp.sock);
	c = vf_close(cftp.sock);
	if(c) irc_Logf("[FTP] close(cftp) %d",c);
	dftp = cftp.other;
	if (dftp != NULL) {
		q = find_ftp(dftp.sock);
		if (q != NULL)
			ftp_kill_data(q);
	}
	s_del(p);
}

define ftp_kil2(cftp)
{
	variable q,dftp;
	dftp = cftp.other;
	if (dftp != NULL) {
		q = find_ftp(dftp.sock);
		if (q != NULL)
			ftp_kill_data(q);
	}
}

define ftp_expire()
{
	variable p0,p,c,now;

	now = unix_time();

	for (p = ftp_list.f; p != NULL; p = p.n) {
		if (now - p.v.time > 90) {
			if (p.v.type[0] != 'C') {
				irc_Logf("[FTP] Data connection timed out %s", p.v.host);
				ftp_kill_data(p);
				!if (ftp_list.ct) break;
			}
		}
		if (p.n == ftp_list.f) break;
	}
% there is a reason for doing the Data-connections 1st
	for (p = ftp_list.f; p != NULL; p = p.n) {
		if (andelse
		     {now - p.v.time > 120}
			   {p.v.other == NULL}
			   {p.v.type[0] == 'C'}
		   )
		{
			irc_Logf("[FTP] Command connection timed out: %s",p.v.host);
			() = clr_action(p.v.sock);
			c = vf_close(p.v.sock);
			if(c) irc_Logf("[FTP] close(cftp) %d",c);
			s_del(p);
			!if (ftp_list.ct) break;
		}
		if (p.n == ftp_list.f) break;
	}

}

define read_ftp_resp(sock,f)
{
	variable n, s,buf,code,ncode,message;
	n = vf_read(sock,&buf);
	if (n <= 0){
		if (n < 0) {
			n = vf_error(sock);
			s = vf_strerr(n);
		}else{
			s = "Port closed";
		}
		s = sprintf("[FTP] Closing command connection: %s",s);
		ftp_kill(f,0,s);
		return (-1,"");
	}
	if (index(buf,'\n') != n) {
		irc_logu("read_ftp returned multi-line");
		return (-1,"");
	}
	buf = chomp(buf);

	f.time = unix_time;
%	irc_Logf("[FTP]<%s",buf);

	if (f.multi != NULL) { % we're waiting for the multi-prefix
		!if(is_prefix(buf,f.multi))
			return (0,buf);
	}
	if (n < 4) return (-1,buf);

	code = substr(buf,1,3);
	ncode = -1;
	if (is_digits(code)) {
		ncode = integer(code);
		if (buf[3] == ' ') {
			f.multi = NULL;
			return (ncode,substr(buf,5,-1));
		}
		if (buf[3] == '-') {
			f.multi = code + " ";
			return (0,substr(buf,5,-1));
		}
	}
	return (-1,buf);
}

% read handler for ftp data-socket -> lvf
%   rvf is Data-socket, wvf is localfile
% write handler for lvf -> ftp data-socket
%   rvf is localfile, wvf is Data-socket
define Hftp_data_x(rvf,wvf,i,p)
{
	variable dftp = p.v;
	variable cftp = dftp.other;
	cftp.time = unix_time;

	variable n = copy_bytes(wvf,rvf,ftpRblok);
	%irc_Logf("[FTP] Data copied [%d]",n);
	if (n > 0) {
		dftp.count += n;
		dftp.time = unix_time;
		irc_set_pm(dftp.meter,dftp.count);
		return;
	}
	if (vf_eof(rvf)) 
		irc_log("[FTP] Data Connex closed");
	else{
		variable r = vf_error(rvf);
		if (r) 
			irc_Logf("[FTP] Data Error[%d]",r);
		else
			irc_log("[FTP] Data unknown error");
	}
	ftp_kill_data(p);
}

% handler for the ftp listen-socket
define Hftp_listen(lsock,i,q)
{
	variable lftp = q.v;
	variable cftp = lftp.other; % the control socket

	variable accept = tcp_accept(lsock);
	if(accept == NULL) {
		irc_log("[FTP] Fail: Can't accept incoming connection.");
		irc_log("[FTP] Dumping...");
	}
	variable remote, port;
	remote = ();
	port = ();

	% Announce to user...
	irc_Logf("[FTP] Data Connection from %s:%d", remote, port);
	variable ripc,ripa;
	(ripc,) = get_remote_ipp(cftp.sock);
	(ripa,) = get_remote_ipp(accept);
	if (ripc != ripa) {
		irc_Logf("[FTP] Fail: Wrong host %s for %s, dropping.",remote,lftp.host);
		() = vf_close(accept);
		return;
	}
	% NOW, close the listen-socket
	() = clr_action(lsock);
	() = vf_close(lsock);

	variable rvf,wvf;
	if (lftp.type[1] == 'S') {
		(rvf,wvf) = (lftp.lvf,accept);
		if (lftp.size > 0)
			lftp.meter = irc_create_pm(lftp.file,lftp.size);
	}else{
		(rvf,wvf) = (accept,lftp.lvf);
	}

	lftp.sock = accept; % changing ftp_list entry to now assoc with accept
	lftp.type = strsub(lftp.type,1,'D');
	lftp.count = 0;
	lftp.time0 = unix_time;
	lftp.time = unix_time;
	() = set_rmode(rvf,-1,ftpRblok); % mode buffered, binary, 1k threshhold
	() = set_wrdep(wvf,rvf,1);   % the dep-link
	() = set_action(wvf, 1, "Hftp_data_x",q); % action is on write-sock
}

define dnote(ret,message)
{
	irc_Logf("[FTP]<%d %s",ret,message);
}

define rm_lfile(ftp)
{
	variable r,name = ftp.lfile;
	if (ftp.type[1] != 'S') {
		r = unlink(name);
		if (is_prefix(name,ftp_dir))
			name = substr(name, 1 + strlen(ftp_dir), -1);
		irc_Logf("[FTP] unlink(%s):%d",name,r);
	}
}

define sftp_KILL(sock,ftp,ret,message)
{
	dnote(ret,message);
	rm_lfile(ftp);
	ftp_kill(ftp, ret, message);
}

define sftp_ANY(me,sock,ftp,ret,message)
{
	dnote(ret,message);
	ftp.type = strsub(ftp.type,3,'2');
	machpush(ftp.mach,-1,me);
	return me;  % because others don't pop it
}

% this result after successful RETR/STOR/etc
define sftp_X226(sock,ftp,ret,message)
{
	dnote(ret,message);
	ftp.type = strsub(ftp.type,3,'2');
	if (ftp.lvf != NULL)
	machpush(ftp.mach,-1,&sftp_ANY);
}

% this result after RETR/STOR/LIST/NLST fails
define sftp_XFERf(sock,ftp,ret,message)
{
	dnote(ret,message);
	ftp_kil2(ftp); % kill just the listen-socket (this closes lfile)
	rm_lfile(ftp);
	ftp.type = strsub(ftp.type,3,'2');
	machpush(ftp.mach,-1,&sftp_ANY);
}

% this result after CWD fails
define sftp_CWDf(sock,ftp,ret,message)
{
	dnote(ret,message);
	ftp.dir = NullString;
	ftp.type = strsub(ftp.type,3,'2');
	if (ftp.lvf != NULL) {
		() = vf_close(ftp.lvf);
		ftp.lvf = NULL;
		rm_lfile(ftp);
	}
	machpush(ftp.mach,-1,&sftp_ANY);
}

define sftp_size(sock,ftp,ret,message)
{
	variable pattern,pos,len,w,lftp;
	dnote(ret,message);
	pattern = sprintf(" BINARY .* for %s +(\\(\\d+\\) bytes*)",ftp.file);
	if (string_match(message,pattern,1)) {
		(pos,len) = string_match_nth(1);
		w = substr(message,pos + 1,len);
		len = integer(w);
		ftp.size = len;
		lftp = ftp.other; % actually, it might already be accepted
		lftp.size = len; 
		lftp.meter = irc_create_pm(ftp.file,len);
		irc_Logf("[FTP] %s (%d bytes)",ftp.file,ftp.size);
	}
	machpush(ftp.mach,-1,&sftp_XFERf); % the default
	machpush(ftp.mach,226,&sftp_X226); % normal success
}

define sftp_XFER(sock,ftp,ret,message)
{
	dnote(ret,message);
	machpush(ftp.mach,-1,&sftp_XFERf);  % the default(failure)
	machpush(ftp.mach,150,&sftp_size); % success-state
	switch (ftp.type[1])
	{case 'S' :	ftp_writes(sock,sprintf("STOR %s\r\n", ftp.file));}
	{case 'R' :	ftp_writes(sock,sprintf("RETR %s\r\n", ftp.file));}
	{case 'L' :	ftp_writes(sock,"LIST\r\n");}
	{case 'N' :	ftp_writes(sock,sprintf("NLST %s\r\n", ftp.file));}
}

define sftp_PORT(sock,cftp,ret,message)
{
	variable lsock,lport,lftp,ip,p;

	dnote(ret,message);
	% time to open a listen-port & do PORT command
	lsock = tcp_listen();
	if(lsock == NULL) {
		irc_log("[DCC] Failed to open listening socket.");
		return;
	}
	lport = ();
	lftp = @FTP_Type;
	lftp.sock = lsock;
	lftp.other = cftp;
	cftp.other = lftp;  % so the command-connex knows about us, too
	lftp.type = strsub(cftp.type,1,'L');
	lftp.host = cftp.host;
	lftp.port = lport;
	lftp.dir = cftp.dir;
	lftp.file = cftp.file;
	lftp.lvf = cftp.lvf;
	cftp.lvf = NULL; % control-socket doesn't need it now.
	%lftp.mach = NULL; % unused
	lftp.size = cftp.size;
	lftp.count = 0;
	lftp.time0 = unix_time;
	lftp.time = unix_time;
	lftp.meter = 0; % filled in later
	p = s_putlast(ftp_list,lftp);
	() = set_action(lsock,0,"Hftp_listen",p);

	machpush(cftp.mach,-1,&sftp_KILL); % the default
	machpush(cftp.mach,200,&sftp_XFER);

	(ip, ) = get_local_ipp(cftp.sock); % yes, because lsock is now on 127.0.0.1
	ftp_writes(sock,sprintf("PORT %s\r\n", ftp_hostport(ip,lport)));
}

define sftp_TYPE(sock,ftp,ret,message)
{
	dnote(ret,message);
	machpush(ftp.mach,-1,&sftp_KILL); % the default
	machpush(ftp.mach,200,&sftp_PORT);
	ftp_writes(sock,"TYPE I\r\n");
}

define sftp_CWD(sock,ftp,ret,message)
{
	dnote(ret,message);
	ftp.type = strsub(ftp.type,3,'1');
	machpush(ftp.mach,-1,&sftp_CWDf); % the default
	machpush(ftp.mach,250,&sftp_TYPE);
	ftp_writes(sock,sprintf("CWD %s\r\n", ftp.dir));
}

define sftp_PASS(sock,ftp,ret,message)
{
	dnote(ret,message);
	machpush(ftp.mach,-1,&sftp_KILL); % the default
	machpush(ftp.mach,230,&sftp_CWD);
	ftp_writes(sock,sprintf("PASS %s@xx.yy\r\n", irc_username));
	return;
}

define sftp_USER(sock,ftp,ret,message)
{
	dnote(ret,message);
	machpush(ftp.mach,-1,&sftp_KILL); % the default
	machpush(ftp.mach,331,&sftp_PASS);
	machpush(ftp.mach,230,&sftp_CWD);
	ftp_writes(sock,"USER anonymous\r\n");
	return;
}

define Hftp_ctrl(sock,i,p)
{
	variable ret,message;
	(ret,message) = read_ftp_resp(sock,p.v);
	if (ret<=0) return; % continued lines, etc, ignored
	variable m0,m1,v,vf = NULL, mach = p.v.mach;
	m0 = mach.f;
	do {
		m1 = m0.n;
		v = m0.v;
		s_del(m0);
		if (v.code == ret) vf = v;
		m0 = m1;
	}while (v.code >= 0);
	if (vf != NULL) v = vf;
	v.func; % so it can ref itself
	@v.func(sock,p.v,ret,message);
	pop ();
}

define ftp_start(host, port, dir, file, lfile, xfer)
{
	variable sock,ftp,lvf,Oflags,p,size = -1,need_CWD;
	

	if (xfer == 'S') {
		irc_Logf("[FTP] Sending %s to ftp://%s:%d/%s/%s",
		         lfile,host,port,dir,file);
		Oflags = O_RDONLY;
	}else{
		irc_Logf("[FTP] Getting %s from ftp://%s:%d/%s/%s",
		         lfile,host,port,dir,file);
		Oflags = O_CREAT | O_WRONLY | O_EXCL;
	}

	if(lfile[0] != '/')
		lfile = ftp_dir + lfile;	

	lvf = vf_open(lfile, Oflags, 0600);
	if (lvf == NULL) {
		irc_Logf("[FTP] unable to open %s: %s", lfile,vf_strerr(vf_errno));
		return;
	}

	if (xfer == 'S') size = vf_size(lvf);

	p = s_find_n1(ftp_list.f,&Hs_cmp,host);
	if (p == NULL) {
		sock = tcp_open(host,port);
		if (sock == NULL) {
			irc_Logf("Can't connect to ftp server %s:%s",host,port);	
			() = vf_close(lvf); % not necessary, since slang destroys it anyway
			return;
		}
	
		() = set_rmode(sock,'\n',ftpRblok);
		ftp = @FTP_Type;
	}else{
		ftp = p.v;
		sock = ftp.sock;
		need_CWD = (dir != ftp.dir);
	}
	ftp.sock = sock;
	ftp.other = NULL; % other -> ftp-record for other port (command/data)
	ftp.type = sprintf("C%c0",xfer);  % Control, not logged in
	ftp.host = host;  % remote host
	ftp.port = port;  % remote port (don't care yet)
	ftp.dir = dir;
	ftp.file = file;
	ftp.lfile = lfile;
	ftp.lvf = lvf;
	ftp.size = size;
	ftp.mach = make_list();
	ftp.time0 = unix_time;
	ftp.time = unix_time;
	%ftp.multi = NULL;

	if (p == NULL) {
		machpush(ftp.mach,-1,&sftp_KILL); % the default
		machpush(ftp.mach,220,&sftp_USER);
		p = s_putlast(ftp_list,ftp);
		() = set_action(sock, 0, "Hftp_ctrl", p);
	}else{
		if (need_CWD) {
			machpush(ftp.mach,-1,&sftp_CWDf); % the default
			machpush(ftp.mach,250,&sftp_TYPE);
			ftp_writes(sock,sprintf("CWD %s\r\n", ftp.dir));
		}else{
			machpush(ftp.mach,-1,&sftp_KILL); % the default
			machpush(ftp.mach,200,&sftp_PORT);
			ftp_writes(sock,"TYPE I\r\n");
		}
	}
}

%define cmd_CTCP_FTP(from, text, isnotice)
%{
%   variable help = _stkdepth;
%   
%   variable num = s_split(text);
%   
%   if(num != 4)
%     {
%	while(_stkdepth > help)
%	  {
%	     num = ();
%	  }
%	return;
%     }
%   
%   ftp_start(host, 21, dir, filename);
%}

define extract_url(stuff)
{
	variable host, request, rest;
	variable dir, file;
	
% can mod this easily to take a port# specifier, etc.
	if (is_prefix_i(stuff,"ftp://")) { % URL is ftp://host/file
		stuff = substr(stuff,7,-1);
		(host,request,rest) = v_split(stuff, "/ ");
		request = "/" + request;
	}else{     % URL is host:file
		(host,request,rest) = v_split(stuff, ": "); % Split FTP style description.
	}	

	if (orelse
		  {host == NullString}
		  {request == NullString}
			{index(host,'/')}
		 )
	{
		irc_Logf("[FTP]  invalid URL ftp://%s/%s", host, request);
		return (NULL,NULL,NULL,NULL);
	}
	file = extract_file(request);
	dir = substr(request, 1, strlen(request) - strlen(file) - 1);
	if (dir[0] != '/') dir = "/" + dir;
	return (host,dir,file,rest);
}

define cmd_FTP_GET(stuff)
{
	variable host, rest;
	variable dir, file, lfile, x;
	
	stuff = strcompress(stuff," \r\n"); % kills embedded spaces!
% can mod this easily to take a port# specifier, etc.
	(host,dir,file,rest) = extract_url(stuff);
	if (host != NULL) {
		lfile = file;
		if (rest != NullString)
			(lfile,) = v_split(rest," ");

		x = 'R'; if (file == NullString) x = 'L';
		ftp_start(host, 21, dir, file, lfile, x);
	}
}

define cmd_FTP_PUT(stuff)
{
	variable host, rest;
	variable dir, file, lfile;
	
	stuff = strcompress(stuff," \r\n"); % kills embedded spaces!
	(lfile,stuff) = v_split(stuff," ");

	(host,dir,file,rest) = extract_url(stuff);
	if (host != NULL) {
		if (file == NullString) file = extract_file(lfile);
		ftp_start(host, 21, dir, file, lfile, 'S');
	}
}

define command_FTP(params)
{
	variable subc;
	variable rest;
	variable func;
	
	(subc, rest) = v_split(params, " ");
	
	func = "cmd_FTP_" + strup(subc);
	
	if(is_defined(func)) {
		rest; eval(func);
	} else {
		irc_Inff("[FTP] Unknown subcommand %s", subc);
	}
}