program ATHTTP,1.0(100)             ! ATE SBX wrapper for HTTP.SBR
!------------------------------------------------------------------------
!This routine allows the Windows-only HTTP.SBR to be called from
!A-Shell/UNIX.
!
!If invoked on a local A-Shell/Windows (non ATE/ATSD) machine, it
!acts just like XCALL HTTP,OP,STATUS,FLAGS,URL$,REQUEST$,RESPONSE$
!
!If invoked in the ATE/UNIX environment, if the file arguments
!(REQUEST$ and RESPONSE$) contain forward slashes, or the
!XHTTPF_FORCEXFR flag is set, then the REQUEST$ file is
!FTP'd to the %ATECACHE% and the result file is FTP'd back.
!Otherwise the filespecs are assumed to be relative to the PC.
!(It is best to use native filespec syntax, or just file.ext for
!the current directory.)
!
!The routine can be invoked via
!
!    XCALL ATHTTP,OP,STATUS,FLAGS,URL$,REQUEST$,RESPONSE$
!
!or (from the ATE side):
!
!   ? TAB(-10,AG_XFUNC);OP,STATUS,FLAGS,URL$,REQUEST$,RESPONSE$;chr(127);
!   input "",STATUS
!
!
!Arguments are identical to those of HTTP.SBR, i.e.:
!
!OP [num, in]:
!   1 (XHTTPOP_REQ) = general HTTP request
!
!STATUS [signed num, out]
!    0 = ok (for simple functions)
!   >0 = response code returned from HTTP server (generally means
!        the that operation succeeded in communicating with the
!        server, but may not be an unqualified success.)
!   <0 = Operational errors (see ASHINC:HTTP.DEF HTTPERR_xxx)
!
!FLAGS [num, in] sum of options flags (see ASHINC:HTTP.DEF XHTTPF_xxx)
!   Also: &h80000000 turns on debugging
!
!URL$ [str, in]
!   Fully qualified URL, with optional path and/or {:port}.  Eg:
!   "http://www.microsabio.net/dist/51dev/temphold/junk.zip"
!   "https://www.paypal.com"
!   "http://someserver.com/some/path:10080"
!
!REQUEST$ [str, in]
!   Contains content of the request, for operations that require it,
!   such as uploading files, POST, etc.  Depending on XHTTPF_FILEREQ
!   flag, may be a string buffer or a filespec (preferably native).
!   For the XHTTPF_REQUPLOAD option, can be a list of filespecs with
!   semi-colon delimiter.  Note that some options only work with
!   file mode, while some may only work with string mode.  See note
!   at top about transferring the file between server and PC.
!   NOTE: max string buffer size 16K as mapped here!
!
!RESPONSE$ [str, in]
!   Filespec where response should be returned.
!   XHTTPF_FILERESP is required for ATHTTP (use HTTP.SBR directly if
!   you want the string buffer version.) For errors
!   that return STATUS<0, it may contain debugging text about the error
!   rather than the actual response.   See note above on XHTTPF_FORCEXFR
!   regarding whether the file will be transferred back to host.
!   NOTE: max string buffer size 16K as mapped here!
!------------------------------------------------------------------------
!Further Notes:
!
!The XCALL will check to see if the ATE client has a current
!copy of ATHTTP.SBX in its BAS: directory (only relevant if BAS: on the
!server and BAS: on the ATE client are not the same place); if
!necessary, the XCALL will transfer a copy of itself to the ATE client
!before then forcing it to execute locally.
!
!AMOS - This routine is quite a ways from being AMOS runtime compatible,
!but for what it's worth, some efforts have been made in that direction.
!These are identified by the ++ifdef AMOS_COMPATIBLE conditionals.
!(If you wanted to make it truly AMOS compatible, you'd have to
!convert it from an SBX to a BSI, remove the debug.print statements,
!deal with the AMOS-to-native filespec translation, etc.
!--------------------------------------------------------------------
!EDIT HISTORY
![100] November 2, 2008 01:25 pm         Edited by Jack
!    Created
!--------------------------------------------------------------------
++pragma SBX
++pragma ERROR_IF_NOT_MAPPED "ON"

++include ashinc:xcall.bsi
++include ashinc:ashell.def
++include ashinc:ashell.sdf
++include ashinc:tcrtex.def
++include ashinc:http.def
++include sosfunc:fnfqfs.bsi
++include sosfunc:fnameext.bsi

    map1 PARAMETERS
        map2 STATUS,F,6
        map2 URL$,S,200
        map2 REQUEST$,S,16384
        map2 RESPONSE$,S,256
        map2 FLAGS,B,4
        map2 OP,B,2

    map1 MISC
        map2 GUIFLAGS,F
        map2 SVR'MTIME,B,4              ! file mtime on server
        map2 SVR'CTIME,B,4              ! file ctype on server
        map2 SVR'BYTES,F                ! size of file on server
        map2 SVR'MODE,B,2               ! file type/mode on server
        map2 CLI'MTIME,B,4              ! file mtime on ATE client
        map2 CLI'CTIME,B,4              ! file ctype on ATE client
        map2 CLI'BYTES,F                ! size of file on ATE client
        map2 CLI'MODE,B,2               ! file type/mode on ATE client
        map2 MIDX,F
        map2 PC'REQUEST$,S,256
        map2 PC'RESPONSE$,S,256
        map2 VERSTR$,S,16
        map2 A,B,1
        map2 A$,S,20
        map2 ATHTTP'SPEC$,S,32
        map2 CCON,B,1
        map2 DBG,B,1

++ifdef AMOS_COMPATIBLE
    map1 Pfn'vars                       ! psuedo-function vars
        map2 Pfn'Name'Ext$,s,64         ! return from Pfn'Name'Ext:
        map2 Pfn'fspec$,s,256           ! param passed to Pfn'Name'Ext, Pfn'FQFS
        map2 Pfn'FQFS$,S,256            ! return from Pfn'FQFS:
++endif

define DBG_MSG$ = " [athttp.sbx debug] > "  ! use for debug msg leadin

!-------------------------------------------------------------------
    significance 11

    on error goto TRAP
BEGIN:
    if XCBCNT < 1 then
        print "Too few args in ATHTTP.SBX"
        xcall MIAMEX,MX'EXITSBX
    endif

    xgetargs OP,STATUS,FLAGS,URL$,REQUEST$,RESPONSE$

    ! if top bit of FLAGS set, activate debugging
    if (FLAGS and &h80000000) then
        xcall MIAMEX,MX_DEBUG,MXOP_GET,DBG
        xcall MIAMEX,MX_DEBUG,MXOP_SET,1
    endif

    debug.print DBG_MSG$+"OP=["+OP+"] STATUS=["+STATUS+"] FLAGS=["+FLAGS+"] URL$=["+URL$+"] REQUEST$=["+REQUEST$[1,32]+"] RESPONSE$=["+RESPONSE$[1,32]+"] "

    ! check our environment
    xcall AUI, AUI_ENVIRONMENT, 2, GUIFLAGS

    ! if any windows, relay to HTTP.SBR
    if (GUIFLAGS and AGF_ANYWIN) then
        debug.print DBG_MSG$+"Windows - treat ATHTTP as HTTP"
        debug.print "Request: "+REQUEST$
        !if REQUEST$[1,1] = """" then REQUEST$ = REQUEST$[2,-2]
        REQUEST$ = Fn'FQFS$(REQUEST$)
        debug.print " (fqfs): "+REQUEST$
        !if RESPONSE$[1,1] = """" then RESPONSE$ = RESPONSE$[2,-2]
        RESPONSE$ = Fn'FQFS$(RESPONSE$)

        debug.print "XCALL HTTP,"+OP+","+STATUS+","+FLAGS+","+URL$+","+REQUEST$+","+RESPONSE$
        xcall HTTP, OP, STATUS, FLAGS, URL$, REQUEST$, RESPONSE$
        xputarg 2, STATUS
        xputarg 6, RESPONSE$
        return (STATUS)
        End
    endif

    ! if no GUI, can't proceed.
    if ((GUIFLAGS and AGF_GUIEXT)=0) then
        xputarg 2,-99       ! bad platform
        if DEBUG ? DBG_MSG$;"ATHTTP not supported under non-GUI non-Windows environment"
        End
    endif

    ! we are running under UNIX and will forward request to ATE client

    ! start by fully-qualifying passed request filespec relative to server, if appl.
    ! response can always use a fixed temp name on the PC
    PC'RESPONSE$ = "%ATECACHE%\athttp.rsp"
    PC'REQUEST$ = REQUEST$
    if ((FLAGS and XHTTPF_FORCEXFR)#0) or instr(1,REQUEST$,"\") < 1 then
        if ((FLAGS and XHTTPF_FILEREQ) # 0) and REQUEST$ # "" then
            ! AMOS-compatible simulation of function Fn'FQFS$
++ifdef AMOS_COMPATIBLE
            Pfn'fspec$ = REQUEST$ : call Pfn'FQFS : REQUEST$ = Pfn'FQFS$
++else
            REQUEST$ = Fn'FQFS$(REQUEST$)   ! expand to fully qualified on server
++endif
            debug.print DBG_MSG$+"REQUEST$ = "+REQUEST$

++ifdef AMOS_COMPATIBLE
            Pfn'fspec$ = REQUEST$ : call Pfn'Name'Ext
            PC'REQUEST$ = "%ATECACHE%\" + Pfn'Name'Ext$
++else
            PC'REQUEST$ = "%ATECACHE%\"+ Fn'Name'Ext$(REQUEST$)
++endif
            debug.print DBG_MSG$+"PC'REQUEST$ = "+PC'REQUEST$
        endif
    endif

    call INVOKE'FROM'SERVER'SIDE
    debug.print DBG_MSG$+"Return STATUS: "+STATUS

    xcall MIAMEX,MX_DEBUG,MXOP_SET,DBG      ! restore original debug flag
    xputarg 2,STATUS
    return(STATUS)

    End


!------------------------------------------------------------------------
! Logic to allow this SBX to be XCALLed from the server side, rather than
! exclusively from the ATE side.  This involves:
!
! 1. Detect if BAS:ATHTTP.SBX present and up to date from ATE perspective.
! 2. If not, transfer it there, using the aux port protocol
! 3. Transfer the request file to ATECACHE
! 3. Tell ATE to invoke the SBX using AG_XFUNC
! 4. Transfer the response file back from ATECACHE
!------------------------------------------------------------------------
INVOKE'FROM'SERVER'SIDE:

    ! turn off control-c during our transfers
    xcall MIAMEX, MX_GETCTRLC,CCON
    if CCON = 1 then
        xcall CCOFF
    endif

    xcall NOECHO                        ! turn off echo

    ! first get status of ATHTTP.SBX on server
    ATHTTP'SPEC$ = "ATHTTP.SBX"
    xcall MIAMEX, MX_FILESTATS, "L", ATHTTP'SPEC$, SVR'BYTES, &
        SVR'MTIME, SVR'CTIME, SVR'MODE

    debug.print DBG_MSG$+"Server "+ATHTTP'SPEC$+": bytes="+SVR'BYTES+" MTIME="+SVR'MTIME

    if (SVR'BYTES < 0) then
        ATHTTP'SPEC$ = "BAS:ATHTTP.SBX"
        xcall MIAMEX, MX_FILESTATS, "L", ATHTTP'SPEC$, SVR'BYTES, &
            SVR'MTIME, SVR'CTIME, SVR'MODE
        debug.print DBG_MSG$+"Server "+ATHTTP'SPEC$+": bytes="+SVR'BYTES+" MTIME="+SVR'MTIME

        if (SVR'BYTES < 0) then
            STATUS = -98
            goto DONE
        endif
    endif

    ! now compare to status of ATHTTP.SBX on ATE
    xcall MIAMEX, MX_FILESTATS, "R", "BAS:ATHTTP.SBX", CLI'BYTES, &
        CLI'MTIME, CLI'CTIME, CLI'MODE

    debug.print DBG_MSG$+"Client BAS:ATHTTP.SBX: bytes="+CLI'BYTES+" MTIME="+CLI'MTIME

    ! note: ideally we would compare the version resources, but currently
    ! this is not an embedded ATE function.  Plus, comparing mtime or ctype
    ! is unreliable because they may change as the file is transferred.
    if SVR'BYTES#CLI'BYTES then
        debug.print DBG_MSG$+"Transferring ATHTTP.SBX to client via ATHTTP..."

        ! check if it exists...
        if lookup("BAS:ATHTTP.SBX")=0 then
            ! if not on disk, then in user mem?
            xcall MIAMEX, MX_USRMAP, MIDX, "ATHTTP.SBX", SVR'BYTES
            if SVR'BYTES = 0 then
                STATUS = -97
                goto DONE
            endif
        endif

        ! transfer ATHTTP.SBX from server to ATE
        ! we could use ATEAPX to avoid FTP, but since we are using FTP anyway,
        ! let's just stik with that...
        !xcall ATEAPX,"BAS:ATHTTP.SBX","%MIAME%\DSK0\007006","ATHTTP.SBX",0,STATUS
        debug.print DBG_MSG$+"Transferring "+Fn'FQFS$(ATHTTP'SPEC$)+" to %ATE%\dsk0\007006\ATHTTP.SBX"
        ? tab(-10,AG_FTP);"0";Fn'FQFS$(ATHTTP'SPEC$);chr(126);"%ATE%\dsk0\007006\ATHTTP.SBX";chr(127);
        xcall ACCEPN,A
        if A = 3 then
            STATUS = -96
            goto DONE
        endif
    endif

    ! now transfer the REQUEST$ arg/file to the PC
    if (FLAGS and XHTTPF_FILEREQ) then
        if REQUEST$ # "" then
            debug.print DBG_MSG$+"Transferring "+REQUEST$+" to "+PC'REQUEST$
            ? tab(-10,AG_FTP);"2";REQUEST$;chr(126);PC'REQUEST$;chr(127);
            xcall ACCEPN,A
            if A = 3 then
                xcall MSGBOX,"Unable to transfer"+chr(13)+chr(10) &
                    + "   "+REQUEST$+chr(13)+chr(10) &
                    + "to" +chr(13)+chr(10) &
                    + "   "+PC'REQUEST$,"ATHTTP.SBX", &
                    MBTN_OK,MBICON_STOP,MBMISC_TASKMODAL
                STATUS = -95
                return
            endif
        endif
    else            ! string buffer REQUEST not supported (yet)
        if A = 3 then
            xcall MSGBOX,"String buffer version of REQUEST argument not supported (yet)", &
                + "ATHTTP.SBX", MBTN_OK,MBICON_STOP,MBMISC_TASKMODAL
            STATUS = -94
            return
        endif
    endif

    ! now tell ATE to invoke ATHTTP on its side, using AG_XFUNC

    debug.print DBG_MSG$+"Invoking ATHTTP.SBX via XFUNC..."
    ? tab(24,1);"Waiting for ATHTTP POST operation...";tab(-1,254);
    ? TAB(-10,AG_XFUNC);"ATHTTP,";OP;",0,";FLAGS;",";URL$;",""";PC'REQUEST$;""",""";PC'RESPONSE$;"""";chr(127);
    input "",A$
    ? tab(24,1);tab(-1,9);
    debug.print DBG_MSG$+"Return status from XFUNC: "+A$
    if A$ = "" then
        STATUS = -92         ! no response ?
    else
        STATUS = val(A$)
    endif
    ! transfer back the RESPONSE if no error...
    if STATUS >= 0 then
        RESPONSE$ = Fn'FQFS$(RESPONSE$)
        debug.print DBG_MSG$+"Transferring "+PC'RESPONSE$+" to "+RESPONSE$
        ? tab(-10,AG_FTP);"3";RESPONSE$;chr(126);PC'RESPONSE$;chr(127);
        xcall ACCEPN,A
        if A = 3 then
            xcall MSGBOX,"Unable to retrieve response file"+chr(13)+chr(10) &
                + "   "+PC'RESPONSE$+chr(13)+chr(10) &
                + "from" +chr(13)+chr(10) &
                + "   "+RESPONSE$,"ATHTTP.SBX", &
                MBTN_OK,MBICON_STOP,MBMISC_TASKMODAL
            STATUS = -93
            return
        endif
    endif

DONE:
    debug.print DBG_MSG$+"Returning STATUS="+STATUS
    if CCON then
        xcall CCON
    endif
    return

TRAP:
    ? "Basic error ";err(0);" in ATHTTP.SBX"
    sleep 4
    return(err(0))
    End


!These "pseudo-functions" might be substituted for the real ones in an
!AMOS environment, but there are so many other reasons why you probably
!wouldn't want to try to call an SBX in an AMOS environment that we'll
!just leave the code here for posterity but otherwise ignore it

++ifdef AMOS_COMPATIBLE
!Note: this "pseudo function" simulates the real function Fn'Name'Ext$()
!but in the form of a GOSUB so that it can run on AMOS.
!-------------------------------------------------------------------------
!Pseudo-Function: Pfn'Name'Ext
!   Return the name.ext portion of an AMOS or native filespec
!Parameters:
!   Pfn'fspec$,s,120 [in]
!
!Returns:
!   Pfn'Name'Ext$ = name.ext
!Globals:
!   none
!Module Variables:
!  none
!Error handling:
!   none
!Examples:
!   DSK0:SYSTAT.LIT[1,4]                --> systat.lit
!   SYS:ERRMSG.USA                      --> errmsg.usa
!   C:\VM\MIAME\DSK0\001004\LOG.LIT     --> log.lit
!   ./abc.xyz                           --> abc.xyz
!   a                                   --> a.dat
!-------------------------------------------------------------------------
Pfn'Name'Ext:

    map1 pne'locals
        map2 pne'x,f
        map2 pne'y,f
        map2 pne'dirsep$,s,1
        map2 pne'status,f
        map2 pne'ddb,ST_DDB              ! used by MX_FSPEC

    ! first determine if the file is already in native format
    pne'x = instr(1,Pfn'fspec$,"/")
    if pne'x > 0 then
        pne'dirsep$ = "/"
    else
        pne'x = instr(1,Pfn'fspec$,"\")
        if pne'x > 0 pne'dirsep$ = "\"
    endif

    if pne'dirsep$ # "" then    ! native format - just strip off dir
        do
            pne'y = instr(pne'x+1,Pfn'fspec$,pne'dirsep$)
            if pne'y then pne'x = pne'y
        loop until pne'y = 0
        Pfn'Name'Ext$ = Pfn'fspec$[pne'x+1,-1]

    else                    ! for AMOS specs, let MX_FSPEC handle it
        ! strip fspec$ down to name.ext for modname$
        xcall MIAMEX, MX_FSPEC, Pfn'fspec$, "", "dat", FS_FMA, pne'ddb, pne'status
        Pfn'Name'Ext$ = lcs(strip(pne'ddb.FILNAM)) +"." + lcs(strip(pne'ddb.EXT))
    endif
    return

!Pseudo-function version of Fn'FQFS$(spec$) for AMOS compatibility
!HOWEVER: I'm not sure what "native" format AMOS specs are supposed
!to take for FTP compatibility, so that remains to be worked out
!---------------------------------------------------------------------
! Function Name:   Fn'FQFS$(spec$)
! Description:     Expand spec$ to a fully qualified file spec
! Author:          Jack McGregor
! Date:            30-Dec-2007
!---------------------------------------------------------------------
!Parameters:
!   spec [string, in] - partially qualified filespec (AMOS or other fmt)
!
!Returns:
!   fully qualified native spec
!Globals:
!   No global vars
!Locals:
!   No other local vars
!Error handling:
!   none
!Notes:
!   Similar to Fn'To'Host()
!   Fn'FQFS$(".") returns current working directory
!--------------------------------------------------------------------
!Edit History
!VEDIT=100
![100] December 30, 2007 09:10 PM        Edited by joaquin
!
!---------------------------------------------------------------------
!{end history}

Pfn'FQFS:                   ! Fn'FQFS$(spec$ as s256) as s256

    map1 pf'locals
        map2 pf'localspec$,s,256
        map2 pf'status,f
        map2 pf'x,f
        map2 pf'pwd,b,1

    map1 pf'ddb,ST_DDB        ! (structure def in ashell.sdf)


    if (Pfn'fspec$ = "." or Pfn'fspec$ = "./" or Pfn'fspec$ = ".\") then
        Pfn'fspec$ = "z.z"
        pf'pwd = 1
    endif

    xcall MIAMEX, MX_FSPEC, Pfn'fspec$, pf'localspec$, pf'ddb.EXT, FS_TOH+FS_FMA,  &
            pf'ddb, pf'status

    if pf'pwd then
        pf'localspec$ = pf'localspec$[1,-5]   ! strip off /z.z
    endif

    Pfn'FQFS$ = pf'localspec$

    return
++endif