*********************************************************************** * Procedure : FTPCLIENT * * * * A simple FTP client program to store a file on a remote host. * * * * FTP requires two connections, a "control" connection to pass * * commands to and from the remote ftp server, and a data connection * * that allows the actual transfer of data. In this proc, %CtlPort * * and %DatPort hold the names of the client socket ports for these * * two functions. Note that the names must match the port definitions * * which are in FTP_PORT_DEFINE. * * * * NB: This routine does Passive mode FTP only!! * * * *********************************************************************** Begin %CtlPnum is Float %CtlSock is Float %DatSock is Float %i is Float %List is Float %Passive is Fixed dp 0 %rc is Float %CtlPort is String Len 64 %DataIP is String Len 15 %DataPort is String Len 5 %DatPort is String Len 16 %err is String Len 255 %Str is String Len 255 %ftpcmd is String Len 255 %ftpresp is String Len 255 %Mode is String Len 15 %Pass is String Len 64 %ProcFile is String Len 8 %ProcName is String Len 255 %RemoteHost is String Len 64 %RemotePort is String Len 16 %Temp is String Len 255 %Type is String Len 15 %uid is String Len 64 %ftpC is Object socket Common %ftpD is Object socket Common * Configuration settings: * Name of control port (must match the defined Janus port name) %CtlPort = 'FTPCTL' * Name of data port (must match the defined Janus port name) %DatPort = 'FTPDAT' * Remote host we're going to connect to (only used if it's not hard-coded in the port definition) %RemoteHost = 'ftp.somewhere.com' * Remote port number (only used if it's not hard-coded in the port definition). %RemotePort = 21 * Userid on remote ftp server. %uid = 'myuserid' * Password on remote ftp server. %Pass = 'password' * Procedure file to retrieve proc from for sending. %ProcFile = 'ALANPROC' * Name of procedure we're sending. %ProcName = 'JSTAT' * Type of transfer: A=ebcdic/ascii, I=Image (binary) %Type = 'A' * Capture the procedure we intend to send via FTP. %List = $ListNew %rc = $ProcOpn(%ProcName, %ProcFile) IF %rc ne 0 Then Print 'Unable to open procedure ''' with %ProcName with - ''' in file ' with %ProcFile Stop END IF %rc = $PROCDAT( %List ) if %rc ne 0 then Print 'Unable to read procedure ''' with %ProcName with - ''' in file ' with %ProcFile with ' return code = ' with %rc Stop end if * Connect the Control port to the remote server (try 4 times * in case the remote port is busy). repeat 4 times %ftpC = New( %CtlPort, host=%RemoteHost, port=%RemotePort ) if %ftpC is Null Then %err = %ftpC:ErrInfo('CODE') * For "temporarily unavailable" errors, we retry. * For all other errors we bail out. if not($OneOf(%err,'-100/-104/-106','/')) then loop end end if else loop end end if pause 1 end repeat if %ftpC Is Null then Text Couldn't connect to FTP server for control socket. {$StatusD} Code={%ftpC:ErrInfo('CODE')} Socket Number={%ftpC:ErrInfo('SOCKNUM')} Function={%ftpC:ErrInfo('FUN')} End Text Jump to Terminate end if * %rc = %ftpC:OnReset('CtlReset') * Set the default 'end of line' characters for ReceiveAndParse %rc = %ftpC:Set( 'PRSTOK', '0D0A') * Read the greeting from the FTP server. If it is not a code 220 * greeting, then we assume the server can not currently accept the * connection, and we bail out. Call FtpCmd( '', %ftpresp, %rc ) if %rc ne 220 then Print %ftpresp Jump to Terminate end if * Try to log in to the FTP server. %ftpcmd = 'USER ' with %uid Call FtpCmd( %ftpcmd, %ftpresp, %rc ) if %rc gt 399 or %rc lt 300 then Print %ftpresp Jump to Terminate end if * If no error, see if we need to supply a password. If so, send it * using the PASS request. We don't bother with the ACCT request. * * We can bypass sending the password if the server has already * granted access. if %rc ne 230 then %ftpcmd = 'PASS ' with %Pass Call FtpCmd( %ftpcmd, %ftpresp, %rc ) if %rc gt 299 OR %rc lt 200 then Print %ftpresp Jump to Terminate end if end if * Send the PASV command to allow us to open the data connection. %ftpcmd = 'PASV' Call FtpCmd( %ftpcmd, %ftpresp, %rc ) * We don't support active mode, so if PASV is rejected we bail out. if %rc lt 200 or %rc gt 299 then %Passive = 0 Jump to Terminate end if * Parse the response from the PASV command to get the IP address * and port for the data connection. Both the IP and port and * port number are transmitted as comma separated decimal values. * The IP address returned from the PASV command may not be the * correct address if the server is behind a firewall that uses NAT. * (Native Address Translation). Since the FTP specification does * not allow the IP address for the control and data connections to * differ, we could ignore the IP address returned and just * copy the IP address in use for the control connection. * NB: The server responds with 6 comma-separated octets. The first * four are the IP address. To get the port, we multiply the fifth * octet by 256 and add the sixth octet. So a response of * 166,1,2,88,10,206 means 166.1.2.88 and port 2766. %ftpresp = $SubStr(%ftpresp, 4) %Temp = $ParseX(%ftpresp, '0123456789') %Temp = $SubStr(%ftpresp, $Len(%ftpresp) - $LEN(%Temp)) repeat 4 times %Str = $Parse(%Temp, ',') %DataIP = %DataIP with %Str with '.' %Temp = $ParseX(%Temp, ',') end repeat %DataIP = $SubStr(%DataIP, 1, $LEN(%DataIP) - 1) %DataPort = $Mod( $Parse(%Temp, ','), 256) * 256 %Temp = $ParseX(%Temp, ',') %DataPort = %DataPort + $Mod( $Parse(%Temp, ' ,)'), 256) * Send the TYPE command to indicate whether binary or Text Data. %ftpcmd = 'TYPE ' with %Type Call FtpCmd( %ftpcmd, %ftpresp, %rc ) if %rc ne 200 then Print %ftpresp Jump to Terminate end if * Make the data transfer connection. repeat 4 times %ftpD = New( %DatPort, host=%DataIP, port=%DataPort ) if %ftpD is Null Then %err = %ftpD:ErrInfo('CODE') * For "temporarily unavailable" errors, we retry. * For all other errors we bail out. if not($OneOf(%err,'-100/-104/-106','/')) then loop end end if else loop end end if pause 1 end repeat if %ftpD Is Null then Text Couldn't connect to FTP server, for data socket. {$StatusD} Code={%ftpC:ErrInfo('CODE')} Socket Number={%ftpC:ErrInfo('SOCKNUM')} Function={%ftpC:ErrInfo('FUN')} End Text Jump to Terminate else Text {}Remote info: {%ftpD:Info( 'REMOTE' )} Connecting on port {%DatPort}... End Text end if * %rc = %ftpD:OnReset('DatReset') * The STOR command tells the server the name of the file to store, and * tells it to start reading from the data socket. %ftpcmd = 'STOR ' with %ProcName Call FtpCmd( %ftpcmd, %ftpresp, %rc ) if %rc lt 100 or %rc gt 199 then %rc = %ftpC:Close Jump to Done end if * Send the data. Text Data ---------> Sending {%Procname}. for %i from 1 to $ListCnt(%List) %rc = %ftpD:Send($LISTINF(%List, %i)) %rc = %ftpD:Send($X2C('0D25')) end for Text Data ---------> Finished Sending. * Close the data connection. %rc = %ftpD:Close Text Data Return Code from "Close" = {%rc} * Look for a response from the STOR command. We will print but * otherwise ignore messages from 200-299, except 227, which indicates * successful transmission of the file. Any other messages confuse * us, thus we terminate the session. repeat forever Call FtpCmd( '', %ftpresp, %rc ) if %rc gt 219 AND %rc lt 251 then loop end end if if %rc gt 299 or %rc lt 200 then Jump to Done end if end repeat * Send the QUIT command to end the control connection. Done: Call FtpCmd( 'QUIT', %ftpresp, %rc ) Jump to Terminate CtlReset: Text Data Control Socket reset - "{%ftpC:ErrInfo('CODE')}" Jump to Terminate DatReset: Text Data Socket reset - "{%ftpD:ErrInfo('CODE')}" Jump to Terminate Terminate: Text Data That was the straw that broke the connection's back. %rc = %ftpC:Close Stop Subroutine FtpCmd( %req is String Len 255 input, - %resp is String output, - %reqRC is Float output) %cont is String Len 1 %rc is Float %resp4 is String Len 4 %rc4 is String Len 4 %ftpC is Object socket Common %ftpD is Object socket Common if %req ne '' then %rc = %ftpC:Send( %req ) if $SubStr(%req, 1 ,4) eq 'PASS' then Text Data Request: Pass xxxxxxxx else Text Data Request: {%req} end if %rc = %ftpC:Send($X2C('0D25'), 'PUSH' ) end if repeat forever %rc = %ftpC:Receive( %resp4, 4, 4) %reqRC = $SubStr(%resp4, 1, 3) %cont = $SubStr(%resp4, 4, 1) %rc = %ftpC:ReceiveAndParse( %resp, -1) Text Data Return code: {%reqRC} Text Data Response: {%resp} if $deBlank(%cont,1) eq '' then loop end else %resp4 = $Substr(%resp4,1,3) with ' ' repeat %rc = %ftpC:Receive( %rc4, 4, 4) %rc = %ftpC:ReceiveAndParse( %resp, -1) Text Data Response: {%resp} if %rc4 eq %resp4 then Print '----------------------------' return end if end repeat end if end repeat Print '----------------------------' return End Subroutine End