source: trunk/SRC/ToBeReviewed/LECTURE/read_ftp.pro @ 378

;+
;
; @file_comments
;
; @categories
;
; @param U
;
; @param CMD
;
; @param RES
;
; @keyword OUT
;
; @keyword COUNT
; Upon return, the number of elements in the result set.
; This is only important when the result set is the empty
; set, in which case COUNT is set to zero.
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO ftp_post, u, cmd, res, out=out, count=count
;
  compile_opt idl2, strictarrsubs
;
  if (cmd ne '') then begin
    printf, u, cmd, format='(a)'
;
; comment out the following line to disable debug info
    print, '>'+cmd
  endif
  if (size(out,/type) eq 0) then out='2?? *'
  catch, err
  if (err ne 0) then return
  line=''
  count=0
  while arg_present(res) do begin
    readf, u, line
    if count eq 0 then res=line else res=[res,line]
    count=count+1
;
; comment out the following line to disable debug info
    print, '<'+line
    if strmatch(line,out) then break
  endwhile
end
;
;+
;
; @file_comments
;
; @categories
;
; @param TEXT
; ASCII text string containing the message.
;
; @param HOST
;
; @param PORT
;
; @restrictions
;
; @examples
;
; @history
;
; @version
; $Id$
;
;-
PRO ftp_parse_pasv, text, host, port
  t=strtrim(text,2)
  ind=where(strcmp(t,'227',3))
  i=ind[0]
  if (i ne -1) then begin
    sub=stregex(t[i],'\([0-9,]*\)',/extract)
    p=strsplit(strmid(sub,1,strlen(sub)-2),',',/extract)
    p=strtrim(p,2)
    host=p[0]+'.'+p[1]+'.'+p[2]+'.'+p[3]
    port=256*long(p[4])+long(p[5])
  endif
end
;
;+
;
; @file_comments
;   READ_FTP, remote_host [, files] [, directory] [,/FILE] [,DATA=variable]
;              [,USER=string] [,PASS=string] [,/PTR]
;
; @param DIR
; Remote directory where the files reside on the ftp server
;
; @param FILES
; A single filename or an array of filenames to be retrieved.
;
; @keyword FILE
; Set this keyword to make a local copy of the file to be
; transferred.  The local file will have the same name as the
; remote file and will be placed in the current working
; directory.
;
; @keyword DATA
; Set this to a named variable that will contain either a
; byte array or an array of pointers to byte arrays with the
; transferred data.  If there is more than one file, an array
; of pointers is returned, one for each file.
; Note that when downloading large files using /FILE
; instead will require much less memory since the entire file
; is not stored in a variable in that case.
;
; @keyword PTR
; Set this keyword to return an array of pointers
; even when there is only one file.
;
; @keyword USER {default=anonymous}
; Specify user name to connect to server with.
;
; @keyword PASS {default=test\@test.com}
; Specify password to use when connecting.
;
; @examples
; 1) Retrieve and print the contents of ftp://ftp.rsinc.com/pub/gzip/README.GZIP:
;   IDL> READ_FTP, 'ftp://ftp.rsinc.com/pub/gzip/README.GZIP', DATA=data
;   IDL> help, data
;          DATA            BYTE      = Array[2134]
;   IDL> print, string(data)
;     ------------------------------------------------------------------------------
;     README file: Research Systems Anonymous FTP site (ftp.rsinc.com)
;                   pub directory
;                   gzip directory
;   ------------------------------------------------------------------------------
;   ...
;
; 2) Retrieve some files from podaac.jpl.nasa.gov and store the files
;    in the current working directory:
;
;   IDL> files = string(lindgen(10)+50,format='(%"MGB370.%3.3d.gz")')
;   IDL> READ_FTP, 'podaac.jpl.nasa.gov', files,  $
;   IDL>       'pub/sea_surface_height/topex_poseidon/mgdrb/data/MGB_370', /FILE
;   IDL> spawn,'dir MGB*',/log_output
;     Volume in drive C is Local Disk
;     Volume Serial Number is 34CE-24DF
;
;     Directory of C:\test\test0307
;
;    07/28/2003  11:58a             362,167 MGB370.050.gz
;    07/28/2003  11:58a             333,005 MGB370.051.gz
;    07/28/2003  11:58a             310,287 MGB370.052.gz
;    07/28/2003  11:58a             358,771 MGB370.053.gz
;    07/28/2003  11:59a             387,282 MGB370.054.gz
;    07/28/2003  11:59a             361,633 MGB370.055.gz
;    07/28/2003  11:59a             383,075 MGB370.056.gz
;    07/28/2003  11:59a             365,844 MGB370.057.gz
;    07/28/2003  11:59a             383,918 MGB370.058.gz
;    07/28/2003  12:00p             372,712 MGB370.059.gz
;                  10 File(s)      3,618,694 bytes
;
;  These compressed files can consequently be opened with OPENR and the
;   /COMPRESSED keyword.
;
; @history
;
; @version
; $Id$
;
; @todo
; seb: que fait-on de "syntax" au debut du header?
; give examples with date in year 0 (should not exists but may happen)
;
;-
PRO read_ftp, site, files, dir, port, data=data, file=file, user=user, $
              pass=pass, ptr=ptr
;
  compile_opt idl2
;
  if n_elements(port) eq 0 then port='ftp'
  if n_elements(files) eq 0 then begin
    if strcmp(site,'ftp://',6) then host=strmid(site,6) else host=site
    pos=strpos(host,'/')
    dir=strmid(host,pos)
    host=strmid(host,0,pos)
    pos=strpos(dir,'/',/reverse_search)
    files=strmid(dir,pos+1)
    dir=strmid(dir,0,pos)
  endif else host=site
  if (size(user,/type) eq 0) then user='anonymous'
  if (size(pass,/type) eq 0) then pass='test@test.com'
                                ;
  socket, u, host, port, connect_timeout=5, read_timeout=5, /get_lun
  ftp_post, u, '', res
  ftp_post, u, 'USER '+user, res, out='3?? *'
  ftp_post, u, 'PASS '+pass, res
  ftp_post, u, 'TYPE I', res
  if (size(dir,/type) ne 0) then ftp_post, u, 'CWD '+dir, res
  if keyword_set(file) or arg_present(data) then begin
    bufsize=512
    buffer=bytarr(bufsize)
    n=n_elements(files)
    if arg_present(data) then dat=ptrarr(n)
    for i=0, n-1 do begin
      ftp_post, u, 'SIZE '+files[i], res, out='213 *'
      sz=long64(strmid(res[n_elements(res)-1],4))
      if arg_present(data) then dat[i]=ptr_new(bytarr(sz))
      ftp_post, u, 'PASV', res
      ftp_parse_pasv, res, host, port
      ftp_post, u, 'RETR '+files[i], res, out='1?? *'
      socket, v, host, port, connect_timeout=5, read_timeout=5, $
         /get_lun, /rawio
      tc=0ll
      if keyword_set(file) then openw,w,files[i],/get_lun
      while (tc lt sz) do begin
        if (sz-tc lt bufsize) then begin
          bufsize=sz-tc
          buffer=bytarr(bufsize)
        endif
        readu, v, buffer, transfer_count=dtc
        if arg_present(data) then $
           (*dat[i])[tc]=(dtc eq bufsize)?buffer:buffer[0:dtc-1]
        if keyword_set(file) then $
           writeu,w,(dtc eq bufsize)?buffer:buffer[0:dtc-1]
        tc=tc+dtc
      endwhile
      free_lun, v
      if keyword_set(file) then free_lun, w
      ftp_post, u, '', res
    endfor
    if arg_present(data) then begin
       if (n gt 1 or keyword_set(ptr)) then data=dat $
       else data=temporary(*dat[0])
     endif
  endif
  ftp_post, u, 'QUIT', res
  free_lun, u
end