OpenVMS Source Code Demos
READ_HTML_APACHE
1000 %title "read_html_apache" !
%ident "version 117.1" ! <<<---+---
declare string constant k_version = "117.1" , ! <<<---+ &
k_program = "read_html_apache" !
!========================================================================================================================
! Title : Read_HTML_Apache_xxx.bas
! Authors: Neil S. Rieck, Steve Kennel
! Purpose: Read data from an HTML form then convert to DCL symbols to be read by another program
! Notes : 1. this program started as a quick hack to enable us to flip from OSU DECthreads to PSC Purveyor
! : 2. it was later modified for use with Apache
! : 3. see program "MIME_DECODE" to extract information from HTML attachments
! : 4. you do not need to add support for URI-based anchor tags ( eg. ?name1=value1&name2=value2#tag ) because
! this information never appears in QUERY_STRING
!
! History:
! ver who when what
! --- --- -------- ---------------------------------------------------------------------------------------------------
! 100 NSR 99.12.08 1. original program
! 101 NSR 00.03.30 1. added a 'develop' switch
! 2. I now assume that we enter this program BEFORE sending an HTML response header
! 102 SMK 20030506 0. modified for use with Apache (CSWS-1.3)
! 1. added a 'method' switch
! NSR 20040610 2. added a DEBUG logical
! 3. added various debug messages to fix a problem with CSWS-2.0
! 4. changed recordsize from 32000 to 999000 (only affects implied EOL; 32-bit strings are still
! limited to a size of 32767 bytes)
! 103 SMK 20060307 1. comment out CONTENT_LENGTH calculation as it was not used and caused error
! SMK 20060308 2. reenabled and modified CONTENT_LENGTH calculation logic
! 104 NSR 20060403 1. modified some documentation
! NSR 20060406 2. modified some documentation
! 105 NSR 20061215 1. started adding code to deal with multiple selects within a SELECT tag (Steve's problem)
! NSR 20061222 2. changed recordsize from 999000 to 999888777 (only affects implied EOL; 32-bit strings are
! still limited to a size of 32767 bytes)
! NSR 20070110 3. now properly dehex an 8-bit "space" bf_105.3
! NSR 20070111 4. reverted (disabled) the 8-bit "space" bf_105.4
! 5. now do support multiple selects within a SELECT with a broken-bar bf_105.5
! 6. added my trace sub program
! 106 NSR 20070112 1. merged code from versions 104 + 105 into this program
! 2. 105 features are now enabled by a variable called ICSISADVANCEDFEATURES=1
! 107 NSR 20080812 1. added code to prevent infinite looping (two places) bf_107.1
! 2. added code to prevent string overflow (two places) bf_107.2
! 108 NSR 20090420 1. added code to limit the i/o time
! 2. changed recordsize from 999888777 to 1999888777
! NSR 20090703 3. changed i/o timeout from 300 secs to 10 secs (two places)
! 4. changed loop counter limit from 30000 to 100 (two places)
! 109 NSR 20090916 1. partial rewrite
! 2. added code to unescape "&"
! 110 NSR 20090916 1. rewrote the query line parser
! 2. rewrote portions of the dehexifier
! NSR 20090917 3. bug fix in the chunk analyzer (screwed up the WOF) bf_110.3
! NSR 20090923 4. added code to drop the priority of this app bf_110.4
! 111 NSR 20091217 1. chasing a bug which removes carriage returns from text boxes
! 2. rewrote the unescape module which was dependent upon edit$(*,4) bf_111.2
! 3. rewrote the dehex module which was dependent upon edit$(*,4) bf_111.3
! 112 NSR 20100606 1. mini-cleanup
! 2. now restrict the length of CONTENT_LENGTH to 32767
! 113 NSR 20110405 1. added code to detect problems with symbols that are over 1024 bytes
! 2. added code to temporarily truncate long symbols bf_113.2
! NSR 20110419 3. extended 'max symbol length' from 1024 to 4096
! 114 abandoned experimental code
! 115 NSR 20110419 1. now employ wcsm_set_symbol_or_logical
! 2. mini cleanup in with respect to external references
! 3. replaced dehex with call to external function wcsm_url_decode
! 116 NSR 20110420 1. dropped the unknown mode handler (now only support GET or POST)
! 2. rewrote the parser to handle standalone query parameters (not of format: name=value)
! 117 NSR 20120719 1. now use wcsm_get_symbol to read QUERY_STRING (>970 bytes?) bf_117.1
!========================================================================================================================
option type=explicit ! cuz no kid stuff
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services (including basic$quadword)
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$jpidef" %from %library "sys$library:basic$starlet" ! jpi$
!
external string function WCSM_TrnLnm (string,string) !
external string function WCSM_url_decode(string) !
external string function wcsm_dt_stamp !
external long function wcsm_set_symbol_or_logical(string,string)
external string function wcsm_get_symbol(string) !
external basic$quadword function wcsm_peek_quad(long by value) !
external long function probe_fsp (string,long) !
external sub trace(string) !
declare string constant dq = "34"C ! double quote
declare long constant max_symbol_len% = 4096 ! VMS-7.3 = 1024, VMS-7.3-2 = 4096
!
declare string L$ , ! line &
b$ , ! buffer &
c$ , ! variable data &
junk$ , ! &
stdin$ , ! standard in &
method$ , ! apache html post or get &
my_string$ , ! apache stdin string &
www_length$ , ! apache stdin string length &
www_string$ , ! apache stdin string (method get) data &
long i% , ! general purpose &
j% , ! &
q% , ! &
temp% , ! &
junk% , ! &
response_sent% , ! &
desired_record_size% , ! &
trace% , ! &
advanced_features% , ! &
debug% , ! &
www_length% , ! &
rc% , ! return code &
handler% , ! &
html_x% , ! &
html_y% , ! &
read_counter% , ! &
cur_priority% , ! &
new_priority% !
dim string v$(500) , ! html variables &
d$(500) , ! html data &
q$(500) ! query chunks
!
!========================================================================================================================
! Main
!========================================================================================================================
Main: !
html_x% = 0 ! init pointer into v$() and d$()
!
junk$ = WCSM_TrnLnm("CSMIS$DEBUG", "LNM$PROCESS_TABLE") ! this might be set by the calling DCl script
when error in !
debug% = integer(junk$) ! 0=Off, 1=On(basic), 2=On(extreme) <<<---***
use !
debug% = 0 !
end when !
debug% = 0 if debug% < 0 !
!
! if we're going to be debugging this program, then we need a plain text response header
!
gosub send_plain_response_header if debug% > 0 !
!
! drop the priority (do not let Apache processes compete with our other users)
!
rc% = lib$getjpi(jpi$_prib,,,cur_priority%,,) ! read our current base priority bf_110.4
if (rc% and 7%) <> 1% then !
print "-e- error: "+ str$(rc%) +" during lib$getjpi" if debug% > 0 !
cur_priority% = 4 ! oops (so default to 4)
end if !
new_priority% = 3 ! desired new priority
if cur_priority% > new_priority% then !
rc% = sys$setpri(,,new_priority% by value,,,) ! don't kill our production system bf_110.4
if (rc% and 7%) <> 1% then !
print "-e- error: "+ str$(rc%) +" during sys$setpri" if debug% > 0
end if !
end if !
!==========================================================================================
! open a channel and read all the incoming ASCII text
!==========================================================================================
when error in !-------------------------------------------------
b$ = "" ! initialize
!
junk% = lib$get_symbol("REQUEST_METHOD",method$) ! this is set by APACHE
print "-i- REQUEST_METHOD: "+ method$ if debug% > 0 !
select method$ !
case "GET" ! GET ---------------------------------------------
!~~~ junk% = lib$get_symbol("QUERY_STRING",www_string$) x
www_string$ = wcsm_get_symbol("QUERY_STRING") ! could be longer than 970 bytes bf_117.1
b$ = www_string$ !
case else ! POST --------------------------------------------
junk% = lib$get_symbol("CONTENT_LENGTH", www_length$) !
www_length% = integer(www_length$, LONG) ! FUTURE NOTE: may need to change type to QUAD
print "www_length "+ str$( www_length% ) if debug% > 0 !
if www_length% > 32767 then ! FUTURE NOTE: use an array to store more data
gosub send_plain_response_header !
print "WARNING, www_length$ is too large ("+ www_length$ +")"
end if !
!
stdin$ = WCSM_TrnLnm("SYS$COMMAND", "LNM$PROCESS_TABLE") !
temp% = pos(stdin$, "_", 0) ! is there an underscore in the BG device
stdin$ = right$(stdin$, temp% + 1) if temp% > 0 ! yes, so get rid of it
temp% = pos(stdin$, ":", 0) ! is there an underscore?
stdin$ = stdin$ +":" if temp% = 0 ! nope, so append one
!
desired_record_size% = probe_fsp(stdin$, debug%) ! diagnostic (to determine record size)
select desired_record_size% !
case 0, > 32767 !
desired_record_size% = 32767 !
end select !
!
open stdin$ for input as #1 &
,organization sequential variable &
,recordtype none &
,recordsize desired_record_size% !
!
! write the raw data received to a temp file for analysis
!
if debug% >= 3 then ! if uber-debugging
when error in !
declare string constant hex_digits$ = "0123456789ABCDEF"
map (wcsm_create_uid_map) basic$octaword octa_buff!
map (wcsm_create_uid_map) byte yada(0 to 15) ! 16 byte buffer for system call
rc% = sys$create_uid(octa_buff) !
!
! now convert to hex
!
junk$ = "" !
for i% = 0 to 15 ! 16 pairs
temp% = yada(i%) ! grab a byte
temp% = 256 + temp% if temp% < 0 !
junk$ = junk$ + mid$(hex_digits$, (temp% / 16%) +1, 1) ! high nibble
junk$ = junk$ + mid$(hex_digits$, (temp% and 15%) +1, 1) ! low nibble
next i% !
!
junk$ = seg$(junk$, 1, 8) +"-"+ ! 4x2= 8 &
seg$(junk$, 9,12) +"-"+ ! 2x2= 4 &
seg$(junk$,13,16) +"-"+ ! 2x2= 4 &
seg$(junk$,17,20) +"-"+ ! 2x2= 4 &
seg$(junk$,21,32) ! 6x2=12
open "csmis$tmp:read_html_apache-debug-"+ junk$ +".txt" for output as #2
use !
end when !
end if !
!
! read from standard i/o
!
while 1 !
wait 2 ! this must not take longer than 2 seconds
linput #1, L$ ! read from browser
wait 0 ! cancel timer
print "-i-current size of L$ = "+ str$(len(L$)) if debug% > 0
read_counter% = read_counter% + 1 !
if read_counter% > 100 then ! oops bf_107.1
gosub send_plain_response_header !
print "WARNING, we executed too many loops" !
rc% = 2 ! VMS-e-
goto fini !
end if !
if (len(b$) + len(L$)) > 32767 then ! if we are about to overflow
gosub send_plain_response_header !
print "WARNING, B$ was about to overflow" !
rc% = 4 ! VMS-f-
goto fini !
end if !
b$ = b$ + L$ ! concat
print #2, L$; if debug% > 2 ! write 'just read' raw dat to debug file
print "-i-current size of B$ = "+ str$(len(B$)) if debug% > 0
next !
end select !
handler% = 0 ! cool
use ! -------------------------------------------------
handler% = err ! oops
end when ! -------------------------------------------------
!
select handler% !
case 252 ! FILE ACP failure (input)
case 11 ! EOF (from while-next on channel #1)
case 0 ! no error (fell thru from cool)
case else ! this should never happen
gosub send_plain_response_header !
print "<pre>" !
print "module -> "+ k_program +"_"+ k_version !
print "basic error-> "+ str$(handler%) !
print "www_length$-> "+ www_length$ !
print "www_length%-> "+ str$(www_length%) !
print " method$ -> "+ method$ +" <--" !
print " stdin -> "+ stdin$ +" <--" !
print " L$ -> "+ L$ +" <--" !
print " b$ -> "+ b$ +" <--" !
end select !
!
! probably got here by EOF so continue
!
when error in !
close #1 !
use !
end when !
!=======================================================================
! at this point, the data to analyze is in b$
!=======================================================================
print "-i-debug >>> whole data line >>>";b$;"<<<" if debug% > 0 !
if pos( edit$(b$,32), "EXPRESSVU_PUBLIC", 1) > 0 then !
trace% = 1 ! enable tracing
call trace("1>"+ wcsm_dt_stamp +"|"+ k_version +"|"+ b$) ! let's see what's happening here <<<<<<<<
end if !
!
if b$ = "" then ! if no data
junk% = lib$set_symbol("READ_APACHE_STATUS","BLANK",1%) !
rc% = 1 ! VMS -s-
goto fini !
end if !
!=======================================================================
! <<< extract the data >>>
!
! caveat1: b$ must be of this format: name1=value1&name2=value2&name3=value3 name/data pair
! or this format2: value1&value2&value3 just data
! but never a mixture of the two
!
! caveat2: the data may not contain an equals character "=" (it will be escaped)
!=======================================================================
j% = pos( b$, "=", 1 ) ! find '='
if j% = 0 then ! this must be a GET with no form fields, so...
c$ = wcsm_url_decode(b$) ! ...decode whole line
junk% = lib$set_symbol("POST_GET_INFO",c$,1) ! set symbol
goto main_exit ! adios
end if !------------------------------------------------
!
! <<< Advanced Mode Enable >>>
!
! 1. In legacy mode we create the symbols as we encounter them. This is a manditory mode for non-compliant HTML
! applications like TRINITY, EXPRESSVU_PUBLIC_VIEWING, etc.
!
! 2. In advanced mode we will allow multiple selects from a <SELECT> by first storing the data into an array
! and then concating the data with broken-bar
!
junk$ = edit$(b$,32) ! upcase the whole thing for the next test
advanced_features% = 1 if pos(junk$, "ICSISADVANCEDFEATURES=1",1) > 0 ! 1
advanced_features% = 1 if pos(junk$, "ICSISADVANCEDFEATURES=T",1) > 0 ! T/RUE
advanced_features% = 1 if pos(junk$, "ICSISADVANCEDFEATURES=Y",1) > 0 ! Y/ES
!
! format1a : "msg=whatever"
! format1b : "first=Neil&last=Rieck&msg=whatever"
! format2 : "first=Neil&last=Rieck&msg=whatever"
! format3a : "whatever" (will yield: whatever=true)
! format3b : "one&msg=whatever&two" (will yield: one=true, msg=whatever, two=true)
!
unescape_amper: !
junk% = pos(b$, "&", 1) ! do we see this HTML entity?
if junk% > 0 then ! yes
b$ = left$(b$, junk%-1) + "&" + seg$(b$, junk%+5, len(b$)) ! bf_111.2
goto unescape_amper !
end if !
!
! <<< now read b$ to create symbols of the form (FORM_FLD_???) >>>
!
when error in !
!
! scan the data line looking for parameters (delimited by ampersands)
!
i% = 1 ! init starting pointer
q% = 0 ! init storage pointer
while i% <= len(b$) ! <= cuz maybe there is only one character there?
j% = pos( b$, '&', i% ) ! find ampersand
if j% = 0 then ! if not found (we are on the last chunk)
q% = q% + 1 ! prep for insert
q$(q%) = seg$( b$, i%, len(b$)) ! store final chunk
i% = len(b$) + 1 ! force WHILE-NEXT to exit
else !
q% = q% + 1 ! prep for insert
q$(q%) = seg$( b$, i%, j%-1) ! store intermediate chunk
i% = j% + 1 ! advance starting pointer past current amper
end if !
print "neil3>"+ str$(q%) +" "+ q$(q%) if debug% > 0 ! display query chunks
next !
!
! now analyze the chunks and only process them
! if they are of the form: "name=value" then process as normal
! if they are of the form: "name" then process as "name=TRUE"
!
i% = 1 ! init retrieval pointer
while i% <= q% !
print "neil4>"+ str$(i%) +" "+ q$(i%) if debug% > 0 !
j% = pos( q$(i%), "=", 1 ) ! locate first equals (=) bf_110.3
if j% > 0 then ! if found
L$ = left$(q$(i%), j%-1) ! isolate the variable name
c$ = seg$( q$(i%), j%+1, len(q$(i%)) ) ! isolate the variable data
c$ = wcsm_url_decode(c$) !
gosub selectively_store_html !
else !
L$ = q$(i%) !
c$ = "TRUE" ! alternatively we could set c$ = L$
gosub selectively_store_html !
end if !
i% = i% + 1 ! advance
next !
use !
junk% = lib$set_symbol("READ_APACHE_STATUS","ERROR",1%) !
end when !
!
! in advanced mode, we need to scan our capture array and create symbols
!
if advanced_features% = 1 and ! if legacy mode is enabled and &
html_x% > 0 ! we have extracted something
then !
for i% = 1 to html_x% !
print "neil6>"+ str$(i%) +" "+ v$(i%) +" "+ d$(i%) if debug% > 0
junk% = lib$set_symbol("FORM_FLD_"+ v$(i%), d$(i%), 1) !
if ((junk% and 7%) <> 1%) and debug% > 0 then !
print "-e-"+ str$(junk%) +" lib$set_symbol a="+ L$ +" c="+ c$
end if !
next i% !
end if !
!
main_exit: !
rc% = 1 ! VMS -s- (success)
goto fini !
!----------------------------------------------------------------------------------------------------
! <<< store html variables and data into v$() and d$() >>>
!
! entry: L$ = variable
! c$ = data
!----------------------------------------------------------------------------------------------------
selectively_store_html:
L$ = edit$(L$, 32) ! always upcase the variable name
call trace("2>"+ wcsm_dt_stamp +"|"+ L$ +"|"+ c$) if trace% = 1 ! let's see what's happening here <<<<<<<<
!
if advanced_features% = 0 then ! if in legacy mode
%let %hack = 1% ! enable new way
%if %hack = 0% %then ! --- old way
if len(c$) > max_symbol_len% then ! bf_113.2
c$ = left$(c$,max_symbol_len%) ! truncate data
end if !
print "neil5> "+ L$ +" "+ c$ if debug% > 0 !
junk% = lib$set_symbol("FORM_FLD_"+ L$, c$, 1%) ! then create the symbol now
if ((junk% and 7%) <> 1%) and debug% > 0 then !
print "-e-"+ str$(junk%) +" lib$set_symbol a="+ L$ +" c="+c$ !
end if !
%else ! --- new way
print "neil5> "+ L$ +" "+ c$ if debug% > 0 !
junk% = wcsm_set_symbol_or_logical("FORM_FLD_"+ L$, c$) ! then create the symbol now
if ((junk% and 7%) <> 1%) and debug% > 0 then !
print "-e-"+ str$(junk%) +" lib$set_symbol a="+ L$ +" c="+c$ !
end if !
%end %if ! -----------
goto selectively_store_html_exit ! and exit
end if !
!
! store HTML (in advanced mode only)
!
goto html_store_next if html_x% = 0 ! jump if first time thru
!
! since this is not the first time through, we must make sure the variable doesn't already exist
!
! Note: for the current time we will concat with "|" which is ASCII code 124.
! In the future we may have to use "broken bar" (¦) which is ASCII code 166.
!
for html_y% = 1 to html_x% ! scan
if v$(html_y%) = L$ then ! if our variable is already stored here...
!~~~ d$(html_y%) = d$(html_y%) +"|"+ c$ x then concat with pipe
d$(html_y%) = d$(html_y%) + chr$(166) + c$ ! then concat with broken bar bf_105.5
goto selectively_store_html_exit ! and exit
end if !
next html_y% !
!
html_store_next:
html_x% = html_x% + 1 ! move to next empty location
v$(html_x%) = L$ ! store variable name
d$(html_x%) = c$ ! store variable contents
!
selectively_store_html_exit: !
return !
!-----------------------------------------------------------------------
! send plain-text response header
!-----------------------------------------------------------------------
send_plain_response_header: !
if response_sent% = 0 then !
margin #0, 132 !
print "Status: 200" ! start of HTML response header
print "Content-type: text/plain" !
print "Content-disposition: inline; filename=";dq;"filename.txt";dq !
print "" ! end of HTML response header
print "-i- program: "+ k_program +"_"+ k_version !
print "-i- debug level: "+str$(debug%) !
response_sent% = 1 !
end if !
return !
!========================================================================================================================
!
! <<< that's all folks >>>
!
fini: !
close #2 if debug% >= 2 !
print "-i- exiting "+ k_program +"_"+ k_version if debug% > 0 !
31000 end program rc% ! <<<---***
!
!########################################################################################################################
!
!=======================================================================
! external functions
!=======================================================================
32100 %include "[.fun]wcsm_trnlnm.fun" !
! function string WCSM_TrnLnm(logical_name$, table_name$)
!
32105 %include "[.fun]wcsm_get_symbol.fun" !
!
32110 %include "[.fun]wcsm_dt_stamp.fun" !
! FUNCTION STRING wcsm_dt_stamp
!
32120 %include "[.fun]wcsm_set_symbol_or_logical.fun" !
! FUNCTION long wcsm_set_symbol_or_logical
!
32130 %include "[.fun]wcsm_peek_Quad.fun"
! function basic$quadword function wcsm_peek_quad(long by value)
!
32140 %include "[.fun]wcsm_url_decode.fun"
! function string wcsm_url_decode(string)
!=======================================================================
! trace
!=======================================================================
32150 sub trace(string trace$) !
option type=explicit !
when error in !
open "csmis$dat:aaa_read_html_apache_trace.txt" as file #5 &
,access append &
,allow modify &
,recordsize 132 !
print #5, trace$ !
use !
end when !
close #5 !
end sub !
!=======================================================================
! title: probe_fsp
!=======================================================================
32160 function long probe_fsp(string my_file$, long debug%) !
option type=explicit !
!
print "-i-debug-entering: display_fsp" if debug% > 0 !
!
declare long handler_error%
!
map(rms_stuff) string rms_stuff = 16 ! only needs to be 16 bytes long, not 32
! as is found in the "HP BASIC Reference Manual"
map(rms_stuff) ! &
byte rs_org , ! 1= 1 &
byte rs_rat , !+1= 2 &
word rs_mrs , !+2= 4 &
long rs_alq , !+4= 8 &
word rs_bks_bls , !+2= 10 &
word rs_num_keys , !+2= 12 &
long rs_mrn !+4= 16
!
when error in !
open my_file$ for input as #100 &
,access read &
,recordtype any &
,organization undefined !
handler_error% = 0 ! cool
use !
handler_error% = err ! oops
end when !
if handler_error% <> 0 then !
print "-e-probe_fsp error: "+ str$(handler_error%) +" on device: "+ my_file$
rs_mrs = 0 !
goto fini !
end if !
!
rms_stuff = fsp$(100) !
goto fini if debug% = 0 !
print " file "; my_file$ !
print " org "; rs_org; !
select rs_org !
case >= 48
print " (hashed)"
case >= 32
print " (indexed)"
case >= 16
print " (relative)"
case else
print " (sequential)"
end select
print " rec attr "; rs_rat !
print " max rec siz "; rs_mrs !
!~~~ print " alloc qty "; rs_alq !
!~~~ print " bucket size "; rs_bks_bls; " (always zero)" x see "User Manual" about bytes 9-12
!~~~ print " num of keys "; rs_num_keys; " (always zero)" x see "User Manual" about bytes 9-12
!~~~ print " max rec num "; rs_mrn x not always zero (see relative tests)
!
fini: !
close #100 !
print "-i-debug-exiting: probe_fsp" if debug% > 0 !
probe_fsp = rs_mrs !
end function !