-- ftp client programma versie 0 date 26-01-15
-- lot of info : http://www.serv-u.com/kb/1446/FTP-Commands
-- and status  : http://www.serv-u.com/kb/1445/FTP-Response-Codes

function prompt_string(sequence prompt)
-- Prompt the user to enter a string
    object answer
    puts(1, prompt)
    answer = gets(0)
    if sequence(answer) and length(answer) > 0 then
        return answer[1..$-1] -- trim the \n
    else
        return ""
    end if
end function 

-- find_any(delim,onderzoek)
-- zoek welk element uit delim als eerste voorkomt in onderzoek 
function find_any(sequence delim;onderzoek)
integer l,j=0  
for i=1 to length(delim) do
    l=find(delim[i],onderzoek)
    if l!=0 and (l<j or j=0) then
       j=l 
    end if
end for 
return j    
end function

-- splits_any(onderzoek,delim)
-- splits onderzoek in elementen gescheiden door elementen in delim
function splits_any(sequence onderzoek;delim)
integer pos=0
sequence res={}
pos=find_any(delim,onderzoek)
while pos do
  res=append(res,onderzoek[1..pos-1])
  onderzoek=onderzoek[pos+1.. ]
  pos=find_any(delim,onderzoek)
end while
if length(onderzoek) then
    res=append(res,onderzoek)    
end if
return res
end function
 
function to_num(sequence num)
sequence tonum=value(num)
return tonum[2]    
end function

procedure put_bytes(integer file,sequence data)
for i=1  to length(data) do putc(file,data[i]) end for
end procedure
   
constant CRLF="\r\n"
constant CMD={"bye","cd","close","get","help","lcd","lpwd","ls","open","put","pwd","quit","type","user"}
integer  net_dev=0 -- device of open on port 21 
constant BLOCKSIZE=4096
sequence URL        -- server
sequence ftpTYP="A" -- ascii
integer  verbose_flag=1, 
         EOL           , -- is een CRLF of LF
         batchfileopen=0 -- kleiner 3 geen scriptbestand  
sequence DATA       -- response 

procedure verbose(sequence data)
  if verbose_flag then puts(1,data) end if  
end procedure                       

function response(integer dev)
-- skip al het commentaar is de antwoorden
sequence data=gets(dev)
while data[4]='-' do 
  verbose(data)
  data=gets(dev)
end while   
return data
end function
  
function PASV(integer net_dev)
constant delim="),("
integer pasv_port       
--enter Pasv mode 
puts(net_dev,"PASV"&CRLF)
DATA = gets(net_dev)
if sequence(DATA) and match("227",DATA) then 
DATA=splits_any(DATA,delim)
pasv_port=256*to_num(DATA[6])+to_num(DATA[7])
verbose("enter Passive \n")
else
printf(1,"Cannot enter Passive mode , server says : %s",DATA)
end if 
pasv_port=open(sprintf("%s:%i",{URL,pasv_port}),"c")
if pasv_port<3 then
printf(1,"passv not found : ",{URL,pasv_port})    
end if
return pasv_port
end function
    
procedure lcd(sequence map)
if length(map)=0 then map='.' end if
-- cd external map
if change_dir(map)<0 then printf(1,"folder %s bestaat niet\n",map)
                     else printf(1,"huidige folder is : %s\n",current_dir())
end if                     
end procedure
integer lcdID=routine_id("lcd") 

procedure lpwd(integer dummie)       
-- locale werkmap
puts(1,current_dir()) puts(1,"\n")
end procedure
integer lpwdID=routine_id("lpwd")


procedure cd(sequence map)
-- cd external map
puts(net_dev,"CWD "&map&CRLF)
DATA = response(net_dev)
puts(1,DATA)
end procedure
integer cdID=routine_id("cd")

procedure ftpclose(integer dummie)
-- "FTP-sessie beeindigen",
if net_dev>0 then
puts(net_dev,"QUIT"&CRLF)
DATA = response(net_dev)
if match("221",DATA) then
puts(1,DATA) 
elsif match("226",DATA) then
DATA = gets(net_dev)
puts(1,DATA) 
else
printf(1,"Disconection error , server says : %s",DATA) 
end if
close(net_dev)
net_dev=0 
end if
-- close session
end procedure
integer closeID=routine_id("ftpclose")

procedure quit(integer dummie)       
-- "FTP-sessie beeindigen en afsluiten",
if net_dev>0 then ftpclose(net_dev) end if
-- close session
abort(0)
end procedure
integer quitID=routine_id("quit")

procedure noprog(integer dummie)       
-- noop
puts(1,"opdracht niet geimplementeerd\n")
end procedure
integer noID=routine_id("noprog")

procedure getftp(sequence filename)       
-- "bestand ontvangen"
integer fileout,pass_dev
-- test of file beschreven kan worden 
fileout=open(filename,"wb")
if fileout<3 then 
DATA =  "Kan bestand : "&filename&" local niet maken\n"
else   
pass_dev=PASV(net_dev)    
puts(net_dev,"RETR "&filename&CRLF)
DATA=response(net_dev) -- 150 
if match("150",DATA) then
 puts(1,DATA)
 if ftpTYP='I' then
  DATA = get_bytes(pass_dev,BLOCKSIZE)
  while sequence(DATA) do
  put_bytes(fileout,DATA)    
  DATA = get_bytes(pass_dev,BLOCKSIZE)
  end while
 else   
  DATA = gets(pass_dev) 
  while sequence(DATA)  do
  puts(fileout,DATA)
  DATA = gets(pass_dev)
  end while
 end if 
 close(pass_dev)
 DATA=response(net_dev) -- 226
else -- error 550   
 close(pass_dev)
end if
close(fileout)
end if
puts(1,DATA)  
end procedure
integer getID=routine_id("getftp") 

procedure putftp(sequence filename)       
-- "bestand verzenden"
integer pass_dev,local=open(filename,"r")
if local<3 then
 DATA="local file : "&filename&" not found\n"
else
-- bestand gevonden nu verzenden
 pass_dev=PASV(net_dev)       
 puts(net_dev,"STOR "&filename&CRLF)
 DATA=response(net_dev) -- 150 
 if match("150",DATA) then
  puts(1,DATA)
 if ftpTYP='I' then
  DATA = get_bytes(local,BLOCKSIZE) 
  while sequence(DATA)  do
   put_bytes(pass_dev,DATA)
   DATA = get_bytes(local,BLOCKSIZE)
  end while
 else              
  DATA = gets(local) 
  while sequence(DATA)  do
   puts(pass_dev,DATA)
   DATA = gets(local)
  end while
 end if 
  close(local) 
  close(pass_dev)
  DATA=response(net_dev) -- 226
 else -- error 550   
  close(pass_dev)
 end if
end if
puts(1,DATA) 
end procedure
integer putID=routine_id("putftp") 

procedure ls(sequence map)       
-- "inhoud externe map" 
integer pass_dev=PASV(net_dev)       
puts(net_dev,"LIST "&map&CRLF)
DATA=response(net_dev) -- 150 
puts(1,DATA) 
if match("150",DATA) then            
DATA = gets(pass_dev) 
while sequence(DATA)  do
puts(1,DATA)
DATA = gets(pass_dev)
end while 
close(pass_dev)
DATA=response(net_dev) -- 226
puts(1,DATA) 
else -- error 550 
close(pass_dev)
end if
end procedure
integer lsID=routine_id("ls") 

procedure pwd(integer dummie) 
puts(net_dev,"PWD"&CRLF)
DATA=response(net_dev) 
printf(1,"pwd = %s\n",DATA)
end procedure
integer pwdID=routine_id("pwd") 

procedure typeftp(sequence typepar)       
DATA = "type alleen A of I of B\n"
-- type        
if find(typepar[1],"bB") then typepar[1]='I' end if
if find(typepar[1],"iaIA") then
ftpTYP=upper(typepar[1])
puts(net_dev,"type "&ftpTYP&CRLF)
DATA=gets(net_dev)
end if
puts(1,DATA)
end procedure
integer typeID=routine_id("typeftp")

procedure passwd(sequence name)      
-- passw
puts(net_dev,"PASS "&name&CRLF) 
DATA = response(net_dev)
if match("230",DATA) then
puts(1,DATA)
else
printf(1,"Bad passw , server reply = %s\n",DATA)    
end if
end procedure

procedure user(sequence name)    
-- user
puts(net_dev,"USER "&name&CRLF)
DATA = response(net_dev) 
if match("331",DATA) then 
if batchfileopen<3 then
DATA=prompt_string("Geef wachtwoord :")    
else  
DATA=gets(batchfileopen) DATA=DATA[1..$-EOL]
end if
passwd(DATA)
elsif match("230",DATA) then
puts(1,DATA)
else    
printf(1,"Bad user name , server says : %s\n",DATA)
end if
end procedure
integer userID=routine_id("user")

procedure openftp(sequence url)
-- "open externe verbinding"
if net_dev>0 then close(net_dev) end if
URL=url
url&=":21" 
net_dev=open(url,"c")
if net_dev<3 then
 printf(1,"Cannot open %s !\n",url)
 net_dev=0
else  
 -- geef response server
 DATA = response(net_dev)
 if match("220",DATA) then 
 puts(1,DATA)
 if batchfileopen>=3 then
 DATA=gets(batchfileopen) DATA=DATA[1..$-EOL]
 user(DATA)
 end if
 else
 printf(1,"Connect error , server reply : %s\n",DATA)    
 end if
end if
end procedure
integer openID=routine_id("openftp") 

procedure help(sequence param) 
integer index
sequence helpon={
                 "FTP-sessie beeindigen en afsluiten",
                 "Externe werkmap wijzigen",
                 "FTP-sessie beeindigen",
                 "Bestanden ontvangen",
                 "Opdrachten zijn :",        
                 "locale werkmap wijzigen",
                 "locale werkmap weergeven",
                 "Inhoud externe map",
                 "naar externe ftp verbinden",
                 "Bestand verzenden",
                 "Externe werkmap weergeven",
                 "FTP-sessie beeindigen en afsluiten", 
                 "bestands overdraagttype instellen",
                 "Gegevens nieuwe gebruiker verzenden",
                 "Onbekende opdracht"}
if length(param) then 
 index=find(param,CMD)
 if index
 then --help on 
      printf(1,"%s %s\n",{CMD[index],helpon[index]})
 else -- unknown command
      printf(1,"%s %s\n",{param,helpon[$]})
 end if
else 
 puts(1,"help functies zijn :\n")
 index=0 
end if
if index=0 then 
 for i = 1 to length(CMD) by 5 do
  for j=0 to 4 do   
   if i+j<=length(CMD) then printf(1,"%10s",CMD[i+j])
                       else exit
   end if                    
  end for  
  puts(1,"\n")
 end for
end if
end procedure
integer helpID=routine_id("help")

-- het bestaat uit een interactief deel en een job gestuurd deel .
-- ftp [ optie [ optie ].. ]  
-- optie = -v onderdruk antwoord van server
-- optie = -s:jobfile

-- main program  
constant FTP="ftp>"
constant CMD_EXE={quitID,cdID,closeID,getID,helpID,lcdID,lpwdID,lsID,openID,putID,pwdID,quitID,typeID,userID} 
constant SER_NEED={  0  ,  1 ,  0    ,  1  ,  0   ,  0  ,  0   , 1  ,  0   ,  1  ,  1  ,   0  ,  1   ,  1   }
sequence cmd,param,batchfile={}
integer cmd_index,i 

procedure FTP_EXE(sequence cmd)
 i=match(" ",cmd)
 if i then param=cmd[i+1..] cmd=cmd[1..i-1] else param={} end if
 -- command decoder
 cmd_index=find(cmd,CMD)
 if cmd_index
 then if net_dev and SER_NEED[cmd_index] or not SER_NEED[cmd_index] then
      call_proc(CMD_EXE[cmd_index],{param})
      else puts(1,"maak eerst een server verbinding met open .\n")
      end if
 else if length(cmd) then printf(1,"%s : deze opdracht bestaat niet\n",cmd) end if
 end if
end procedure

-- start program
DATA="FTP versie 0.1 door Menno S. Ter Haseborg 15-02-15\n"
verbose(DATA)
cmd=command_line()
-- cmd[1] = peu(w) dan is cmd[2] gelijk ftp en cmd[3] en hoger parameters
-- cmd[1] = ftp dan cmd[2] en hoger parameters .
if lower(cmd[1])="ftp" then i=2 else i=3 end if
-- parameters in i en hoger .
if length(cmd)>=i then
 -- -v kill server commentaar
 -- -s:filename naam besturings bestand .
 for j=i to length(cmd) do
 if cmd[j][1..2]="-v" then
    verbose_flag=0
 elsif cmd[j][1..2]="-s" then
    batchfile=cmd[j][4..] 
 end if
 end for 
end if
-- einde parameters
if length(batchfile) then
 batchfileopen=open(batchfile,"r")
 if batchfileopen <3 then 
 puts(1,"Script bestand : "&batchfile&" niet gevonden .\n")
 else DATA="200" -- begin met een goed antwoord
 -- moet beginen met
 -- open server
 -- username
 -- pasword 
 -- DATA moet nu 230 zijn ten teken dat ingeloged is
 cmd=gets(batchfileopen)
 -- waar eind de regel op ? een CRLF of een LF 
 if match(CRLF,cmd) then EOL = 2 else EOL = 1 end if
 while sequence(cmd) do
 puts(1,cmd)  
 FTP_EXE(cmd[1..$-EOL]) -- strip lf
 -- wat te doen als response een 5xx of 4xx terug geeft ?        
 cmd=gets(batchfileopen)
 end while
 close(batchfileopen)
 end if
else -- manual 
 while 1 do
 cmd=prompt_string(FTP) 
 FTP_EXE(cmd) 
 end while
end if