| [613] | 1 | ONCX10A ;HCIOFO/SG - HTTP 1.0 CLIENT (TOOLS) ; 8/11/04 8:26am
|
|---|
| 2 | ;;2.11;ONCOLOGY;**40,41**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** APPENDS RECEIVED PIECE OF DATA TO THE DESTINATION BUFFER
|
|---|
| 7 | ;
|
|---|
| 8 | ; BUF Received data
|
|---|
| 9 | ;
|
|---|
| 10 | ; [NEWLINE] Start a new line after appending the data
|
|---|
| 11 | ;
|
|---|
| 12 | ; The ONC8BUF, ONC8DST, ONC8IS, ONC8MBL, ONC8PTR, and ONC8SL
|
|---|
| 13 | ; variables must be properly initialized before calling this
|
|---|
| 14 | ; procedure (see the $$RECEIVE^ONCX10A for details).
|
|---|
| 15 | ;
|
|---|
| 16 | APPEND(BUF,NEWLINE) ;
|
|---|
| 17 | N BASE,L
|
|---|
| 18 | S L=$L(BUF) S:$A(BUF,L)=13 L=L-1
|
|---|
| 19 | ;--- Append the data
|
|---|
| 20 | I L'<ONC8SL D
|
|---|
| 21 | . S ONC8BUF=ONC8BUF_$E(BUF,1,ONC8SL),L=L-ONC8SL
|
|---|
| 22 | . S BASE=1
|
|---|
| 23 | . F D Q:L'>0
|
|---|
| 24 | . . I 'ONC8IS S @ONC8DST@(ONC8PTR)=ONC8BUF
|
|---|
| 25 | . . E S @ONC8DST@(ONC8PTR,ONC8IS)=ONC8BUF
|
|---|
| 26 | . . S BASE=BASE+ONC8SL,ONC8IS=ONC8IS+1,ONC8SL=ONC8MBL
|
|---|
| 27 | . . S ONC8BUF=$E(BUF,BASE,BASE+ONC8SL-1),L=L-ONC8SL
|
|---|
| 28 | . S ONC8SL=-L
|
|---|
| 29 | E S ONC8BUF=ONC8BUF_$E(BUF,1,L),ONC8SL=ONC8SL-L
|
|---|
| 30 | ;--- Flush the buffer and start a new line
|
|---|
| 31 | I $G(NEWLINE) D S ONC8BUF="",ONC8IS=0,ONC8PTR=ONC8PTR+1,ONC8SL=ONC8MBL
|
|---|
| 32 | . I 'ONC8IS S @ONC8DST@(ONC8PTR)=ONC8BUF Q
|
|---|
| 33 | . S @ONC8DST@(ONC8PTR,ONC8IS)=ONC8BUF
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ;***** CALCULATES NUMBER OF BYTES IN THE MESSAGE BODY
|
|---|
| 37 | ;
|
|---|
| 38 | ; ONC8DATA Closed root of a variable containing body
|
|---|
| 39 | ; of the message
|
|---|
| 40 | ;
|
|---|
| 41 | ; NLS Length of the line terminator(s)
|
|---|
| 42 | ;
|
|---|
| 43 | DATASIZE(ONC8DATA,NLS) ;
|
|---|
| 44 | N SIZE
|
|---|
| 45 | S SIZE=0
|
|---|
| 46 | F S I=$O(@ONC8DATA@(I)) Q:I="" D S SIZE=SIZE+NLS
|
|---|
| 47 | . S SIZE=SIZE+$L($G(@ONC8DATA@(I)))
|
|---|
| 48 | . S J=""
|
|---|
| 49 | . F S J=$O(@ONC8DATA@(I,J)) Q:J="" D
|
|---|
| 50 | . . S SIZE=SIZE+$L($G(@ONC8DATA@(I,J)))
|
|---|
| 51 | Q $S(SIZE>0:SIZE-NLS,1:0)
|
|---|
| 52 | ;
|
|---|
| 53 | ;***** PROCESSES THE HTTP HEADER
|
|---|
| 54 | ;
|
|---|
| 55 | ; .ONC8H Reference to a local array containing
|
|---|
| 56 | ; the raw header data
|
|---|
| 57 | ;
|
|---|
| 58 | ; .ONC8HDR Reference to a local variable where the parsed
|
|---|
| 59 | ; header will be returned
|
|---|
| 60 | ;
|
|---|
| 61 | ; Return values:
|
|---|
| 62 | ; <0 Error Descriptor
|
|---|
| 63 | ; >0 HTTP Status Code^Description
|
|---|
| 64 | ;
|
|---|
| 65 | HEADER(ONC8H,ONC8HDR) ;
|
|---|
| 66 | N BUF,I,NAME,TAB,TMP
|
|---|
| 67 | S ONC8HDR=$$NORMSTAT($G(ONC8H(1))),TAB=$C(9)
|
|---|
| 68 | F I=2:1 S BUF=$TR($G(ONC8H(I)),TAB," ") Q:BUF="" D
|
|---|
| 69 | . ;--- Continuation of the previous header line
|
|---|
| 70 | . I $E(BUF,1)=" " D:$G(NAME)'="" Q
|
|---|
| 71 | . . S TMP=$$TRIM^XLFSTR(BUF)
|
|---|
| 72 | . . S:TMP'="" ONC8HDR(NAME)=ONC8HDR(NAME)_" "_TMP
|
|---|
| 73 | . ;--- New header line
|
|---|
| 74 | . S NAME=$$UP^XLFSTR($$TRIM^XLFSTR($P(BUF,":")))
|
|---|
| 75 | . S:NAME'="" ONC8HDR(NAME)=$$TRIM^XLFSTR($P(BUF,":",2,999))
|
|---|
| 76 | Q $P(ONC8HDR," ",2)_U_$P(ONC8HDR," ",3,999)
|
|---|
| 77 | ;
|
|---|
| 78 | ;***** NORMALIZES THE HTTP STATUS LINE
|
|---|
| 79 | NORMSTAT(STATUS) ;
|
|---|
| 80 | N I,J1,J2,TMP
|
|---|
| 81 | ;--- Remove leading and trailing spaces
|
|---|
| 82 | S STATUS=$$TRIM^XLFSTR(STATUS)
|
|---|
| 83 | ;--- Replace groups of consecutive spaces with single spaces
|
|---|
| 84 | S J2=1
|
|---|
| 85 | F I=1,2 D Q:'J1
|
|---|
| 86 | . S J1=$F(STATUS," ",J2) Q:'J1
|
|---|
| 87 | . F J2=J1:1 Q:$E(STATUS,J2)'=" "
|
|---|
| 88 | . S $E(STATUS,J1,J2-1)=""
|
|---|
| 89 | ;--- Return normalized status line
|
|---|
| 90 | Q STATUS
|
|---|
| 91 | ;
|
|---|
| 92 | ;***** RECEIVES AN HTTP RESPONSE
|
|---|
| 93 | ;
|
|---|
| 94 | ; TIMEOUT Timeout value (in seconds) for TCPIP input.
|
|---|
| 95 | ;
|
|---|
| 96 | ; [ONC8DATA] Closed root of the variable where the message
|
|---|
| 97 | ; body is returned. See the $$GETURL^ONCX10
|
|---|
| 98 | ; for details.
|
|---|
| 99 | ;
|
|---|
| 100 | ; [.ONC8HDR] Reference to a local variable where the parsed
|
|---|
| 101 | ; headers will be returned. See the $$GETURL^ONCX10
|
|---|
| 102 | ; for details.
|
|---|
| 103 | ;
|
|---|
| 104 | RECEIVE(TIMEOUT,ONC8DATA,ONC8HDR) ;
|
|---|
| 105 | ; ONC8BUF Work buffer where the current line is being built
|
|---|
| 106 | ; ONC8DST Closed root of the current destination buffer used
|
|---|
| 107 | ; by the APPEND^ONCX10A
|
|---|
| 108 | ; ONC8H Temporary buffer for the raw HTTP header
|
|---|
| 109 | ; ONC8IS Subscript of the current continuation sub-node in
|
|---|
| 110 | ; the destination buffer (if 0 then the current main
|
|---|
| 111 | ; node is used)
|
|---|
| 112 | ; ONC8MBL Maximum buffer length
|
|---|
| 113 | ; ONC8PTR Subscript of the current node in the dest. buffer
|
|---|
| 114 | ; ONC8SL Number of available bytes in the current (sub)node
|
|---|
| 115 | ;
|
|---|
| 116 | N $ESTACK,$ETRAP,BLCHS,BUF,EXIT,I1,I2,MBL,ONC8BUF,ONC8DST,ONC8H,ONC8IS,ONC8MBL,ONC8PTR,ONC8SL,RTO,STATUS,TMP,X
|
|---|
| 117 | S BLCHS=$C(9,10,12,13)_" ",ONC8MBL=245
|
|---|
| 118 | K:$G(ONC8DATA)'="" @ONC8DATA K ONC8HDR
|
|---|
| 119 | S ONC8BUF="",ONC8IS=0,ONC8PTR=1,ONC8SL=ONC8MBL
|
|---|
| 120 | ;--- Setup the error processing
|
|---|
| 121 | S X="RCVERR^ONCX10A",@^%ZOSF("TRAP"),$ETRAP=""
|
|---|
| 122 | ;--- Receive the header (until the first empty line)
|
|---|
| 123 | U IO
|
|---|
| 124 | S ONC8DST="ONC8H",(EXIT,RTO)=0
|
|---|
| 125 | F R BUF#ONC8MBL:TIMEOUT S RTO='$T D Q:EXIT!RTO
|
|---|
| 126 | . S I1=1
|
|---|
| 127 | . F S I2=$F(BUF,$C(10),I1) Q:'I2 D Q:EXIT
|
|---|
| 128 | . . S TMP=$E(BUF,I1,I2-2) D APPEND(TMP,1) S I1=I2
|
|---|
| 129 | . . S:$TR(TMP,BLCHS)="" EXIT=1
|
|---|
| 130 | . D:'EXIT APPEND($E(BUF,I1,ONC8MBL))
|
|---|
| 131 | ;--- A header must end with an empty line.
|
|---|
| 132 | ;--- Otherwise, there was a timeout.
|
|---|
| 133 | Q:'EXIT $$ERROR^ONCXERR(-7)
|
|---|
| 134 | ;--- Remove ending of the header from the buffer. The buffer
|
|---|
| 135 | ;--- can contain beginning of the message body.
|
|---|
| 136 | S:I1>1 $E(BUF,1,I1-1)=""
|
|---|
| 137 | ;--- Process the header
|
|---|
| 138 | S STATUS=$$HEADER(.ONC8H,.ONC8HDR)
|
|---|
| 139 | ;--- Receive the message body
|
|---|
| 140 | D:$G(ONC8DATA)'=""
|
|---|
| 141 | . N CNTLEN,RDLEN
|
|---|
| 142 | . S RDLEN=ONC8MBL
|
|---|
| 143 | . ;--- Check for Content-Length header
|
|---|
| 144 | . I $D(ONC8HDR("CONTENT-LENGTH")) D Q:CNTLEN'>0
|
|---|
| 145 | . . S CNTLEN=+ONC8HDR("CONTENT-LENGTH")
|
|---|
| 146 | . . S:CNTLEN<ONC8MBL RDLEN=CNTLEN
|
|---|
| 147 | . E S CNTLEN=-1
|
|---|
| 148 | . ;--- Read the content
|
|---|
| 149 | . S ONC8DST=ONC8DATA,RTO=0
|
|---|
| 150 | . F D Q:'CNTLEN!RTO R BUF#RDLEN:TIMEOUT S RTO='$T
|
|---|
| 151 | . . D:CNTLEN>0
|
|---|
| 152 | . . . S CNTLEN=CNTLEN-$L(BUF) S:CNTLEN<0 CNTLEN=0
|
|---|
| 153 | . . . S:CNTLEN<RDLEN RDLEN=CNTLEN
|
|---|
| 154 | . . S I1=1
|
|---|
| 155 | . . F S I2=$F(BUF,$C(10),I1) Q:'I2 D
|
|---|
| 156 | . . . D APPEND($E(BUF,I1,I2-2),1) S I1=I2
|
|---|
| 157 | . . D APPEND($E(BUF,I1,ONC8MBL))
|
|---|
| 158 | ;--- Flush the buffers and process the header (only if necessary)
|
|---|
| 159 | RCVERR U $P
|
|---|
| 160 | D APPEND("",1)
|
|---|
| 161 | S:$G(STATUS)="" STATUS=$$HEADER(.ONC8H,.ONC8HDR)
|
|---|
| 162 | Q STATUS
|
|---|
| 163 | ;
|
|---|
| 164 | ;***** SENDS THE HTTP REQUEST
|
|---|
| 165 | ;
|
|---|
| 166 | ; URI Request URI
|
|---|
| 167 | ;
|
|---|
| 168 | ; [ONC8DATA] Closed root of a variable containing body of the
|
|---|
| 169 | ; request message. If this parameter is defined, not
|
|---|
| 170 | ; empty, and the referenced variable is defined then
|
|---|
| 171 | ; the POST request is generated. Otherwise, the GET
|
|---|
| 172 | ; request is sent.
|
|---|
| 173 | ;
|
|---|
| 174 | ; [.ONC8HDR] Reference to a local variable containing header
|
|---|
| 175 | ; values
|
|---|
| 176 | ;
|
|---|
| 177 | ; Return values:
|
|---|
| 178 | ; <0 Error Code^Description
|
|---|
| 179 | ; "GET" Ok
|
|---|
| 180 | ; "POST" Ok
|
|---|
| 181 | ;
|
|---|
| 182 | REQUEST(URI,ONC8DATA,ONC8HDR) ;
|
|---|
| 183 | N CRLF,DFLTHDR,I,J,STATUS
|
|---|
| 184 | S CRLF=$C(13,10)
|
|---|
| 185 | ;--- Check for default header(s)
|
|---|
| 186 | S DFLTHDR("CONTENT-LENGTH")=""
|
|---|
| 187 | S DFLTHDR("CONTENT-TYPE")=""
|
|---|
| 188 | S DFLTHDR("USER-AGENT")=""
|
|---|
| 189 | S I=""
|
|---|
| 190 | F S I=$O(ONC8HDR(I)) Q:I="" K DFLTHDR($$UP^XLFSTR(I))
|
|---|
| 191 | S:$D(DFLTHDR("USER-AGENT")) ONC8HDR("User-Agent")="VistA/1.0"
|
|---|
| 192 | ;--- Send the request
|
|---|
| 193 | U IO
|
|---|
| 194 | I $G(ONC8DATA)'="",$D(@ONC8DATA)>1 S STATUS="POST" D
|
|---|
| 195 | . S:$D(DFLTHDR("CONTENT-TYPE")) ONC8HDR("Content-Type")="text/html"
|
|---|
| 196 | . D:$D(DFLTHDR("CONTENT-LENGTH"))
|
|---|
| 197 | . . S ONC8HDR("Content-Length")=$$DATASIZE(ONC8DATA,$L(CRLF))
|
|---|
| 198 | . W "POST "_URI_" HTTP/1.0",CRLF,!
|
|---|
| 199 | . ;--- Header
|
|---|
| 200 | . S I=""
|
|---|
| 201 | . F S I=$O(ONC8HDR(I)) Q:I="" W I_": "_ONC8HDR(I),CRLF,!
|
|---|
| 202 | . ;--- Body
|
|---|
| 203 | . S I=""
|
|---|
| 204 | . F S I=$O(@ONC8DATA@(I)) Q:I="" D
|
|---|
| 205 | . . W CRLF,$G(@ONC8DATA@(I)),!
|
|---|
| 206 | . . S J=""
|
|---|
| 207 | . . F S J=$O(@ONC8DATA@(I,J)) Q:J="" W $G(@ONC8DATA@(I,J)),!
|
|---|
| 208 | E S STATUS="GET" D
|
|---|
| 209 | . W "GET "_URI_" HTTP/1.0",CRLF,!
|
|---|
| 210 | . S I=""
|
|---|
| 211 | . F S I=$O(ONC8HDR(I)) Q:I="" W I_": "_ONC8HDR(I),CRLF,!
|
|---|
| 212 | . W CRLF,!
|
|---|
| 213 | U $P
|
|---|
| 214 | Q STATUS
|
|---|
