OpenVMS Source Code Demos
axis2_soap_test_tool
1000 %title "Axis2_soap_test_tool_xxx.bas"
%ident "131.2" ! <<<---***
declare string constant k_version = "131.2" , ! &
k_program = "axis2_soap_test_tool" !
!========================================================================================================================
! Title : axis2_soap_demo_xxx.bas
! Author : Neil S. Rieck
! Purpose: demo client calls to Apache AXIS2 (via Tomcat)
! Notes : 1. by declaring the passing mechanisms in the external statements, it seems that we don't need to use
! the VMS-BASIC "loc()" function to substitute for an ampersand (address ref) in DEC-C and VAX-C
! 2. this program must be built (from DCL) as follows:
! method A: @ axis2_soap_demo xxx (where xxx is the version number)
! method B: $ basic file.bas
! $ basic [.dvlp]WCSM_TCP_FUNCTIONS_109.fun
! $ link file,WCSM_TCP_FUNCTIONS_109
! 3. with AXIS and AXIS2, the choice of using SOAP-1.1 or SOAP-1.2 is determined by how you do the POST (or
! GET). It can also be controlled by namespaces
! 4. this program only uses hard-coded wsdl data so might be considered an extreme example of the "wdsl first"
! (contract first) method. In the real world we would fetch the wsdl, parse it, then "soft bind" to it
! which is known as the "code first" method.
! History:
! Ver Who When What
! --- --- ------ --------------------------------------------------------------------------------------------------------
! 131 NSR 180110 0. derived from TRODB_TO_SOAP_TEST_TOOL_130.BAS
! 1. removed a lot of stuff "FOR THIS DEMO"
! NSR 180111 2. added a bunch of new test cases
!========================================================================================================================
option type=explicit ! no tricks
!
declare string constant k_prod_1 = "kawc96.on.bell.ca" !
declare string constant k_dvlp_1 = "kawc09.on.bell.ca" !
!
declare long constant TCPBUFSIZ = 32767 !
declare long constant k_timeout_limit% = 3 !
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$spawn
%include "$rmsdef" %from %library "sys$library:basic$starlet" ! rms$
!
! home brewed code
!
external string function wcsm_dt_stamp ! ccyymmddhhmmss
external string function wcsm_dt_stamp_alt ! ccyymmdd.hhmmss
external string function WCSM_TrnLnm (string,string) !
external sub ascii_dump (string) !
external string function ipv4_to_string(long) !
!
! program constants
!
declare word constant k_xmit_size_w = TCPBUFSIZ , ! &
k_recv_size_w = TCPBUFSIZ !
declare string constant k_alarm$ = "wseif???" ! for OpenVMS-style messages (eg. -e- )
declare string constant dq = '34'C ! double quote (ascii 34)
!
map(xyz)string sendbuf$ = k_xmit_size_w , ! &
recvbuf$ = k_recv_size_w !
!
! program variables
!
declare long debug , ! &
handler_error% , ! &
sanity_comm_error% , ! &
rc , ! return code &
stage% , ! for debugging &
i% , ! &
j% , ! &
response_counter% , ! &
timeout_count% , ! &
pos1% , ! &
pos2% , ! &
my_options% , ! &
iterations% , ! &
score% , ! &
wsdl_flag% , ! &
junk% , ! &
junk9% , ! &
hack% , ! &
weekday% , ! &
read_only% , ! &
asset_test% , ! &
ld% , ! &
try% , ! &
mask% , ! &
file31_open% , ! &
long recvlen% , ! &
sendlen% , ! &
dst_port_w% , ! &
default_port_w% , ! &
single start_time , ! &
end_time , ! &
string temp$ , ! &
msg$ , ! &
tst_case$ , ! &
force_err$ , ! &
alt_tcase$ , ! &
result$ , ! &
params$ , ! &
doc$ , ! &
junk$ , ! &
junk2$ , ! &
junk_01_02$ , ! &
junk_04_17$ , ! &
hack_service$ , ! &
hack_soap_action$ , ! &
hack_url_patch$ , ! &
hack$ , ! &
service$ , ! VDSL - ADSL &
src_host$ , ! &
dst_node$ , ! &
host_param$ , ! only used in "Host:" parameter &
dst_addr$ , ! &
http_rc$ , ! &
debug$ , ! &
choice$ , ! &
recvdata$ , ! &
basic$QuadWord DeltaQuad , ! &
my_quad , ! &
long flag_open% , ! &
ccb% , ! connection control block (tcpware) &
ncv_rec ncv , ! network connection variables &
ncv2 , ! support for a second connection &
long dest_kind , ! &
ipv4_address , ! &
string dest$ , ! &
path$ , ! &
word tcp_port !
!-----------------------------------------------------------------------
%include "[.inc]wcsm_tcp_support_109.inc" ! my custom TCP functions
%include "[.inc]device_controls.inc" ! vt + la escape codes
!
!=======================================================================
! <<< main >>>
!=======================================================================
main: ! <<<---***
print vt$132; !
print "===========================================================" !
print " "+ k_program +"_"+ k_version !
print "===========================================================" !
margin #0, 132 ! wrap the log file
print "-i-width is set to 132 (hopefully you issued $SET TERM/WRAP)" !
print "-i-this program cannot (yet) do SSL so avoid port 443" !
!
! get input from the user
!
input "debug level? (0-4, default=1) ";junk$ !
when error in !
debug = integer(junk$) !
debug = 1 if edit$(junk$,2) = "" ! default to "1"
use !
debug = 1 ! error out to "1"
end when !
select debug !
case < 0 !
debug = 0 !
case > 4 !
debug = 4 !
end select !
print "-i-debug level: "+ str$(debug) !
!
get_menu_mode: !
print "===========================================================" !
print " Work Bench Menu (Tomcat must be running AXIS or AXIS)" !
print "===========================================================" !
print "Reminder: Did you enable AUTO-WRAP on your terminal? <<<---***"
print " 0 = GET HTTP /axis2/services/listServices"
print " 1 = GET HTTP /axis2/services/Version?wsdl"
print " 2 = GET HTTP /axis2/services/Version?xsd"
print " 3 = GET HTTP /axis2/services/Version/getVersion"
print " 4 = PUT SOAP 1.1 /axis2/services/Version getVersion"
print " 4E = PUT SOAP 1.1 same as '4' but with bad XML"
print " 5 = PUT SOAP 1.2 /axis2/services/Version getVersion"
print " 6 = PUT SOAP 1.1 /axis2/services/SimpleService ssEcho"
print " 6E = PUT SOAP 1.1 same as '6' but with wrong NS"
print " 72 = GET HTTP /axis2/services/SimpleService?wsdl"
print " 82 = GET HTTP /axis2/services/SimpleService?wdsl2"
print " 92 = GET HTTP /axis2/services/SimpleService/ssEcho?param0=this is a test"
print " 12 = PUT SOAP 1.1 /axis2/services/SimpleService ssEcho "
print " 12A = PUT SOAP 1.2 /axis2/services/SimpleService ssEcho "
print " 93 = GET HTTP /axis2/services/SimpleService/ssAdd?param0=7¶m1=4"
print " 13 = PUT SOAP 1.1 /axis2/services/SimpleService ssAdd "
print " 13A = PUT SOAP 1.2 /axis2/services/SimpleService ssAdd "
print " 94 = GET HTTP /axis2/services/SimpleService/ssSubtract?param0=7¶m1=4"
print " 14 = PUT SOAP 1.1 /axis2/services/SimpleService ssSubtract "
print " 14A = PUT SOAP 1.2 /axis2/services/SimpleService ssSubtract "
print " ----- Transaction Tests for Bell-ATS developers -------------------------------+"
input "test case? (0-99, default=exit) ";tst_case$ !
%let %destinaton=1
%if %destinaton=0 %then
print
print "destination menu"
print " 1 = ";k_prod_1
print " 2 = ";k_dvlp_1
input "destination node: (1-2,default=2) ";dst_node$
select dst_node$
case "2"
dst_node$ = k_dvlp_1
case else
dst_node$ = k_prod_1
end select
%else
dst_node$ = k_dvlp_1
%end %if
!
! my option bits
!
declare long constant k_frc_err = 1 !
declare long constant k_alt_test_case = 2 !
declare long constant k_iterate = 4 !
!
my_options% = 0 ! zap all bits
!
suffix_loop: !
tst_case$ = edit$(tst_case$,32+2) ! upcase, no-white-space
select tst_case$
case ""
goto fini
end select
!
! detect F/orce_error suffix
!
junk% = pos(tst_case$,"F",1) ! F/orce_error
if junk% > 0 then !
mid$(tst_case$,junk%,1) = " " !
my_options% = my_options% or k_frc_err !
goto suffix_loop ! (get more?)
end if !
!
! detect force_E/rror suffix
!
junk% = pos(tst_case$,"E",1) ! force_E/rror
if junk% > 0 then !
mid$(tst_case$,junk%,1) = " " !
my_options% = my_options% or k_frc_err !
goto suffix_loop ! (get more?)
end if !
!
! detect A/lternate_tcase suffix
!
junk% = pos(tst_case$,"A",1) ! A/lternate
if junk% > 0 then !
mid$(tst_case$,junk%,1) = " " !
my_options% = my_options% or k_alt_test_case !
goto suffix_loop ! (get more?)
end if !
!
! detect I/terate suffix
!
junk% = pos(tst_case$,"I",1) ! I/terate
if junk% > 0 then !
mid$(tst_case$,junk%,1) = " " !
my_options% = my_options% or k_iterate !
goto suffix_loop ! (get more?)
end if !
!
! continue with test case logic
!
tst_case$ = "0" if tst_case$ = "" !
!
when error in !
junk% = integer(tst_case$) !
use !
junk% = -99 !
end when !
!
if src_host$ = "kawc09.on.bell.ca" then ! if we're on kawc09
dst_node$ = "kawc96.on.bell.ca" ! then go to kawc96 (most of the time)
else ! else
dst_node$ = "kawc09.on.bell.ca" ! then go to kawc09 (most of the time)
end if !
default_port_w% = 8080 !
print "-i-test case: "; tst_case$ !
!
! get input the desired destination info (hardcoded for now)
!
dst_addr$ = dst_node$ if dst_addr$ = ""
print "destination server? (default="+ dst_addr$ +") "; !
input junk$ !
junk$ = edit$(junk$,2) !
dst_addr$ = junk$ if junk$ <> "" !
!
get_port:
print "destination port? (default="+ str$(default_port_w%)+") "; !
input junk$ !
when error in !
junk% = integer(junk$) !
use !
junk% = -1 !
end when !
select junk% !
case 0 !
dst_port_w% = default_port_w% !
case 1 to 32767 !
dst_port_w% = junk% !
case else !
print "-e-Huh?" !
goto get_port !
end select !
!
! a little crud to make my new stuff work
!
dest$ = "" ! init
dest$ = dst_addr$ ! use address
dest$ = dst_node$ if dest$ = "" ! use fqdn if necessary
!
!
! note: if dest$ is compound (eg. contains path) then it will be split between dest$ and path$
!
ipv4_address = nsr_adr_prep(debug, dest$, path$, dest_kind) !
select dest_kind !
case 1 ! dest$ was an IPv4 addr
print "-i-using IPv4 address:"; ipv4_address; !
print "(";ipv4_to_string(ipv4_address);")" !
case 2 !
print "-i-dns: "+dest$+" translated to: "; ipv4_address; !
print "(";ipv4_to_string(ipv4_address);")" !
case else !
print "-e-destination: "+dest$+" is not usable" !
goto fini !
end select !
tcp_port = dst_port_w% ! (7=echo, 23=telnet, 80=http, 8080=tomcat)
host_param$ = dest$ +":"+ str$(tcp_port) ! variable used in "Host:" parameter of HTTP/1.1
sleep 1
!
!========================================================================================================================
! iteration loop
!========================================================================================================================
iteration_loop: !
if (my_options% and k_iterate) <> 0% then ! if iterations are enabled...
select iterations% !
case 0 !
start_time = time(0) !
case >= 199 !
end_time = time(0) !
print "-i-finished "+ str$(iterations%) +" iterations" !
print "-i-elapsed time: "; !
print using "###.###"; end_time - start_time; !
print " secs" !
my_options% = my_options% and (-1% - k_iterate) !
goto fini !
end select !
iterations% = iterations% + 1 !
print "-i-starting iteration "+ str$(iterations%) +" ----------------------------------------"
end if !
!
!========================================================================================================================
! communicate with Tomcat (or Apache)
!========================================================================================================================
sendbuf$ = "" !
recvbuf$ = "" !
recvdata$ = "" !
!
!
!------------------------------------------------------------------------------------------------------------------------
! create a socket
!------------------------------------------------------------------------------------------------------------------------
stage% = 1
rc = nsr_tcp_prep(debug, ncv) ! allocate flags, channels, etc.
gosub display_rc !
goto rc_exit if (rc and 7%) <> 1 !
!------------------------------------------------------------------------------------------------------------------------
! connect
!------------------------------------------------------------------------------------------------------------------------
stage% = 2
rc = nsr_tcp_open(debug, ncv, ipv4_address, tcp_port,"0 0:0:05.0" ) !
gosub display_rc !
goto rc_exit if (rc and 7%) <> 1 !
flag_open% = 1 ! show open
!------------------------------------------------------------------------------------------------------------------------
! <<< send the data packet >>>
!------------------------------------------------------------------------------------------------------------------------
!
!-----------------------------------------------------------------------
! <<< test case 0 >>>
!-----------------------------------------------------------------------
if tst_case$ = "0" then !
msg$ = ! &
"GET /axis2/services/listServices HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! means this BASIC program &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 1 >>>
!-----------------------------------------------------------------------
if tst_case$ = "1" then !
wsdl_flag% = 1 !
msg$ = ! &
"GET /axis2/services/Version?wsdl HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 2 >>>
!-----------------------------------------------------------------------
if tst_case$ = "2" then !
msg$ = ! &
"GET /axis2/services/Version?xsd HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 3 >>>
!-----------------------------------------------------------------------
if tst_case$ = "3" then !
msg$ = ! &
"GET /axis2/services/Version/getVersion HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 4 >>>
!-----------------------------------------------------------------------
if tst_case$ = "4" then !
if (my_options% and k_frc_err) <> 0% then ! if error test case
!
! this soap message contains an XML typo (see: 'SOAX' under <SOAP:Envelope) bf_102.2
!
print "-w-will force an XML error" ! danger Wil Robinson
sleep 1 !
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
! --- THE NEXT LINE CONTAINS A TYPO ("SOAX" rather than "SOAP") --- &
' xmlns:SOAX="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:getVersion xmlns:ns0="http://axisversion.sample"' +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' </ns0:getVersion>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
else ! else NOT error test case
!
! notes:
! 1) "xsi" is sometimes called URI in the w3 documentation for SOAP 1.1
! 2) xmlns:ns0 can be either one of:
! "http://axisversion.sample" (works with AXIS2)
! "urn:Version" (works with AXIS2)
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
!~~~ ' <ns0:getVersion xmlns:ns0="http://axisversion.sample"' +cr+lf +&
' <ns0:getVersion xmlns:ns0="urn:Version"' +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' </ns0:getVersion>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
end if !
!
! with no encoding type we will default to: x-www-form-urlencoded (hopefully)
!
! it appears that SOAPaction is required with "SOAP 1.1"
! but the associated "urn" doesn't really do anything with Java-based servers
! but may be required with .NET-based servers
!
msg$ = &
"POST /axis2/services/Version HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-Type: text/xml; charset="utf-8"' +cr+lf+ ! required with SOAP 1.1 &
!~~~ 'SOAPAction: "/axis2/services/Version"' +cr+lf+ x this seems to work &
!~~~ 'SOAPAction: "getVersion"' +cr+lf+ x this seems to work &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'SOAPAction: ""' +cr+lf+ ! this seems to work with Axis2/Java &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 5 >>>
!-----------------------------------------------------------------------
if tst_case$ = "5" then !
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf+ &
'<env:Envelope' +cr+lf+ &
' xmlns:env="http://www.w3.org/2003/05/soap-envelope"' +cr+lf+ &
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf+ &
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf+ &
' <env:Body>' +cr+lf+ &
' <ns0:getVersion xmlns:ns0="http://axisversion.sample"' +cr+lf+ &
' env:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf+ &
' </ns0:getVersion>' +cr+lf+ &
' </env:Body>' +cr+lf+ &
'</env:Envelope>'
!
! with no encoding type we will default to: x-www-form-urlencoded (hopefully)
!
msg$ = ! &
"POST /axis2/services/Version HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-type: application/soap+xml; charset=UTF-8' +cr+lf+ ! required with SOAP 1.2 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 6 >>>
!-----------------------------------------------------------------------
if tst_case$ = "6" then !
if (my_options% and k_frc_err) <> 0% then ! if error test case
!
! this soap message contains the wrong namespace (xmlns:ns0)
! which I accidentally copied from elsewhere
!
print "-w-will force a NS error" ! danger Wil Robinson
sleep 1 !
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssEcho xmlns:ns0="http://axisversion.sample"' +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>this is a test</ns0:param0>' +cr+lf +&
' </ns0:ssEcho>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
else ! else not error test case
!
! notes: 1) "xsi" is sometimes called URI in the w3 documentation for SOAP 1.1
! 2) notice the declaration change for "xmlns:ns0" (info came from the WSDL and XSD)
! 3) the variable name "param0" is visible in both the WSDL and XSD
! 4) xmlns:ns0 should work with either one of:
! "http://ws.apache.org/axis2"
! "urn:SimpleService"
! but only works with the first one. Is this because SimpleService is a POJO and
! was not built properly by me?
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssEcho xmlns:ns0="http://ws.apache.org/axis2"' ! this does work ! +cr+lf +&
!~~~ ' <ns0:ssEcho xmlns:ns0="urn:SimpleService"' !! this doesn't work +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>this is a test</ns0:param0>' +cr+lf +&
' </ns0:ssEcho>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
end if
!
! with no encoding type we will default to: x-www-form-urlencoded (hopefully)
!
! it appears that SOAPaction is required with "SOAP 1.1"
! but the associated "urn" doesn't really do anything with Java-based servers
! but may be required with .NET-based servers
!
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-Type: text/xml; charset="utf-8"' +cr+lf+ ! required with SOAP 1.1 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'SOAPAction: ""' +cr+lf+ ! this seems to work with Axis2/Java &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 12 (HTTP-put version of test-case 6) >>>
!
! Note: you switch between SOAP-1.1 and SOAP-1.2 by using the proper namespaces
!-----------------------------------------------------------------------
if tst_case$ = "12" then !
!
if (my_options% and k_alt_test_case) = 0% then ! normal (soap 1.1) ----------------------
print "-i-sending SOAP 1.1 (alternate test case)" !
sleep 1 !
!
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope ' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:ENC="http://schemas.xmlsoap.org/soap/encoding/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssEcho xmlns:ns0="http://ws.apache.org/axis2">' +cr+lf +&
!~~~ ' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>this is a test</ns0:param0>' +cr+lf +&
' </ns0:ssEcho>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
!
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-Type: text/xml; charset="utf-8"' +cr+lf+ ! required with SOAP 1.1 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'SOAPAction: ""' +cr+lf+ ! this seems to work with Axis2/Java &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
else ! alt (soap (1.2) ------------------------
print "-i-sending SOAP 1.2"
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope xmlns:SOAP="http://www.w3.org/2003/05/soap-envelope">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssEcho xmlns:ns0="http://ws.apache.org/axis2">' +cr+lf +&
!~~~ ' SOAP:encodingStyle="http://www.w3.org/2003/05/soap/encoding">' +cr+lf +&
' <ns0:param0>this is a test</ns0:param0>' +cr+lf +&
' </ns0:ssEcho>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-type: application/soap+xml; charset=UTF-8' +cr+lf+ ! required with SOAP 1.2 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
end if !----------------------------------------
gosub send_msg !
print "<<< a SOAP repsonse is expected >>>" !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 13 >>>
!
! Note: With gSOAP, you switch between SOAP-1.1 and SOAP-1.2 by
! using the proper namespaces. This means you should not have used
! switches "-1" or "-2" in the invocation of soapcpp2
!-----------------------------------------------------------------------
if tst_case$ = "13" then !
!
if (my_options% and k_alt_test_case) = 0% then ! normal (soap 1.1) ----------------------
print "-i-sending SOAP 1.1 (alternate test case)" !
sleep 1 !
!
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:ENC="http://schemas.xmlsoap.org/soap/encoding/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssAdd xmlns:ns0="http://ws.apache.org/axis2"' +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>123</ns0:param0>' +cr+lf +&
' <ns0:param1>456</ns0:param1>' +cr+lf +&
' </ns0:ssAdd>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
!
! with no encoding type we will default to: x-www-form-urlencoded (hopefully)
!
! it appears that SOAPaction is required with "SOAP 1.1"
! but the associated "urn" doesn't really do anything with Java-based servers
! but may be required with .NET-based servers
!
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-Type: text/xml; charset="utf-8"' +cr+lf+ ! required with SOAP 1.1 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'SOAPAction: ""' +cr+lf+ ! this seems to work with Axis2/Java &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
else !----------------------------------------
print "-i-sending SOAP 1.2"
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://www.w3.org/2003/05/soap-envelope"' +cr+lf +&
' xmlns:ENC="http://www.w3.org/2003/05/soap-encoding"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/Schema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssAdd xmlns:ns0="http://ws.apache.org/axis2"' +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>123</ns0:param0>' +cr+lf +&
' <ns0:param1>456</ns0:param1>' +cr+lf +&
' </ns0:ssAdd>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Content-type: application/soap+xml; charset=UTF-8' +cr+lf+ ! required with SOAP 1.2 &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
end if !----------------------------------------
gosub send_msg !
print "<<< a SOAP repsonse is expected >>>" !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 14 >>>
!-----------------------------------------------------------------------
if tst_case$ = "14" then !
!
if (my_options% and k_alt_test_case) = 0% then ! normal (soap 1.1) ----------------------
print "-i-sending SOAP 1.1 (alternate test case)" !
print 1 !
!
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope' +cr+lf +&
' xmlns:SOAP="http://schemas.xmlsoap.org/soap/envelope/"' +cr+lf +&
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"' +cr+lf +&
' xmlns:xsd="http://www.w3.org/2001/XMLSchema">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssSubtract xmlns:ns0="http://ws.apache.org/axis2"' ! this does work ! +cr+lf +&
!~~~ ' <ns0:ssSubtract xmlns:ns0="urn:SimpleService"' !! this doesn't work +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>456</ns0:param0>' +cr+lf +&
' <ns0:param1>123</ns0:param1>' +cr+lf +&
' </ns0:ssSubtract>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
!
! with no encoding type we will default to: x-www-form-urlencoded (hopefully)
!
! it appears that SOAPaction is required with "SOAP 1.1"
! but the associated "urn" doesn't really do anything with Java-based servers
! but may be required with .NET-based servers
!
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Content-Type: text/xml; charset="utf-8"' +cr+lf+ ! required with SOAP 1.1 &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'SOAPAction: ""' +cr+lf+ ! this seems to work with Axis2/Java &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
else ! ---------------------------------------
print "-i-sending SOAP 1.2" !
doc$ = &
'<?xml version="1.0" encoding="UTF-8"?>' +cr+lf +&
'<SOAP:Envelope xmlns:SOAP="http://www.w3.org/2003/05/soap-envelope">' +cr+lf +&
' <SOAP:Body>' +cr+lf +&
' <ns0:ssSubtract xmlns:ns0="http://ws.apache.org/axis2"' ! this does work ! +cr+lf +&
!~~~ ' <ns0:ssSubtract xmlns:ns0="urn:SimpleService"' !! this doesn't work +cr+lf +&
' SOAP:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +cr+lf +&
' <ns0:param0>456</ns0:param0>' +cr+lf +&
' <ns0:param1>123</ns0:param1>' +cr+lf +&
' </ns0:ssSubtract>' +cr+lf +&
' </SOAP:Body>' +cr+lf +&
'</SOAP:Envelope>'
msg$ = &
"POST /axis2/services/SimpleService HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Content-type: application/soap+xml; charset=UTF-8' +cr+lf+ ! required with SOAP 1.2 &
"Content-Length: "+ str$( len(doc$) ) +cr+lf+cr+lf+ ! end of header &
doc$ !
end if ! ---------------------------------------
gosub send_msg !
print "<<< a SOAP repsonse is expected >>>" !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 92 >>>
!-----------------------------------------------------------------------
if tst_case$ = "92" then !
msg$ = ! &
"GET /axis2/services/SimpleService/ssEcho?param0=this%20is%20a%20test HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 72 >>>
!-----------------------------------------------------------------------
if tst_case$ = "72" then !
msg$ = ! &
"GET /axis2/services/SimpleService?wsdl HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 82 >>>
!-----------------------------------------------------------------------
if tst_case$ = "82" then !
msg$ = ! &
"GET /axis2/services/SimpleService?wsdl2 HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 93 >>>
!-----------------------------------------------------------------------
if tst_case$ = "93" then !
msg$ = ! &
"GET /axis2/services/SimpleService/ssAdd?param0=7¶m4=3 HTTP/1.1" +cr+lf+ ! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< test case 94 >>>
!-----------------------------------------------------------------------
if tst_case$ = "94" then !
msg$ = ! &
"GET /axis2/services/SimpleService/ssSubtract?param0=7¶m1=4 HTTP/1.1" +cr+lf+! &
"Host: "+ host_param$ +cr+lf+ ! &
'User-Agent: Neil' +cr+lf+ ! &
'Connection: close' +cr+lf+ ! required with HTTP/1.1 &
'Accept: text/xml' +cr+lf+cr+lf ! end of header
gosub send_msg !
goto wait_for_a_response !
end if !
!-----------------------------------------------------------------------
! <<< no more test-cases past this point >>>
!-----------------------------------------------------------------------
print "-e-unhandled condition (programmer error)" !
goto fini !
!------------------------------------------------------------------------------------------------------------------------
! <<< send message >>>
!------------------------------------------------------------------------------------------------------------------------
send_msg: !
print "-i-send_msg <<<<<<<<<<"
if debug >= 1 then !
print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
print "-i-DEBUG: will send:"
print msg$
print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
end if !
sendbuf$ = msg$ !
sendlen% = len(edit$(sendbuf$, 128)) ! compute data string length (no trailing spaces)
!
if debug >= 3 then !
print "xmit bytes: "+ str$(sendlen%) !
if sendlen% > 0 then !
print "xmit data start ----------------------------------------------------------vvvvv"
print left$(sendbuf$,sendlen%) !
print "xmit data end ----------------------------------------------------------^^^^^"
end if !
end if !
call ascii_dump(left$(sendbuf$,sendlen%)) if (debug >= 4) and (sendlen% > 0)
!
stage% = 3
rc = nsr_tcp_send(debug, ncv, sendbuf$, sendlen%, "0 0:0:05") !
gosub display_rc !
goto rc_exit if (rc and 1%) <> 1% !
!
!------------------------------------------------------------------------------------------------------------------------
! <<< wait for the event flag to change state) >>>
!------------------------------------------------------------------------------------------------------------------------
wait_for_a_response: !
response_counter% = 0 ! init first time thru
timeout_count% = 0 ! init first time thru
!------------------------------------------------------------------------------------------------------------------------
! <<< receive the data >>>
!------------------------------------------------------------------------------------------------------------------------
!
! loop entry pt.
!
read_buffer_loop: !
!~~~ response_counter% = 0 x
!
recv_loop: ! <<<---***
stage% = 4
print "-i-checking recv buffer (count:"; response_counter%+1; ")" !
rc = nsr_tcp_recv( debug, ncv, recvbuf$, TCPBUFSIZ, recvlen%, "0 0:0:00.9") ! recv with 900 mS time limit
if debug >= 3 then !
print "-i-recv-rc :"+ str$(rc) !
print "-i-recv bytes: "+ str$( recvlen% ) !
if recvlen% > 0 then !
print "recv data start vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv"
print left$(recvbuf$,recvlen%) !
print "recv data end ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
end if !
end if !
call ascii_dump(left$(recvbuf$,recvlen%)) if (debug >= 4) and (recvlen% > 0)
if (rc and 1%) = 1% then ! if ok
junk$ = left$(recvbuf$,recvlen%) !
%let %datacleanup=3% ! 0=off, 1=compress, 2=super clean, 3=post super
%if %datacleanup=0% %then ! off
! do nothing
%end %if !
%if %datacleanup=1% %then ! compress
junk$ = edit$(junk$, 16 ) ! reduce spaces and tabs to one space
%end %if !
%if %datacleanup=2% %then ! really compress
for junk% = 1 to len(junk$) !
junk2$ = mid$(junk$, junk%, 1) !
select asc(junk2$) !
case < 32, > 126 ! control character?
mid$(junk$, junk%, 1) = " " ! yes so replace with <space>
end select !
next junk% !
junk$ = edit$(junk$, 16 ) ! compress
%end %if !
recvdata$ = recvdata$ + junk$ ! continuing buffering
else !
select rc !
case SS$_THIRDPARTY !
print "-w-status:";rc;"network partner disconnected logical link (3rd party)"
goto pgm_error_exit !
case SS$_LINKDISCON !
print "-w-status:";rc;"network partner disconnected logical link"
goto pgm_error_exit !
case SS$_VCCLOSED !%SYSTEM-F-VCCLOSED, virtual circuit closed
print "-w-status:";rc;"network partner closed" !
goto pgm_error_exit !
case SS$_TIMEOUT !
print "-w-status:";rc;"operation timeout" !
goto pgm_error_exit !
case else !
print "-i-rc "+ str$(rc) !
gosub display_rc !
goto rc_exit !
end select !
end if !
!
read_buffer_bypass: !
response_counter% = response_counter% + 1 !
print "-i-debug: read/poll counter = "+ str$(response_counter%) !
if timeout_count% < k_timeout_limit% then !
print "-i-timeout_count% <= "+ str$(k_timeout_limit%) +" so trying another read"
goto read_buffer_loop !
else !
print "-w-read abort type 2" !
end if !
pgm_error_exit: !
!
http_rc$ = "" ! init
result$ = "-w-no buffered data" ! init
goto close_the_connection if len(recvdata$)=0 ! jump if nothing was found
%if %datacleanup=3% %then ! post cleanup
print "-i-post cleanup 3 (buffer size:";len(recvdata$);")" !
junk$ = "" ! init
junk9% = 0 ! init
for junk% = 1 to len(recvdata$) !
junk2$ = mid$(recvdata$, junk%, 1) !
select asc(junk2$) !
case 10, 13 ! lf, cr
junk$ = junk$ + lf + cr if junk9% = 0 !
junk9% = 1 ! do not do this multiple times
case < 32, > 127 !
junk$ = junk$ + junk2$ !
print "-i-char: ";junk%;" asc: "; str$(asc(junk2$)) ! 8=HTAB
junk9% = 0 !
case else !
junk$ = junk$ + junk2$ !
junk9% = 0 !
end select !
next junk% !
recvdata$ = edit$(junk$, 256+128+16+8) ! compress
%end %if !
print "-i-Data: "+ recvdata$ !
call ascii_dump(recvdata$) if (debug >= 4) and (recvdata$ <> "") !
!
! detect variations of "HTTP/1.1 200 OK"
!
print "===================================================="
print "-i-WSDL_flag: "+ str$(wsdl_flag%) !
if left$(recvdata$,4) = "HTTP" then ! look for phrase starting with HTTP
pos1% = pos(recvdata$," ",1) ! look for first space
pos2% = pos(recvdata$," ",pos1%+1) ! look for next space
http_rc$ = seg$(recvdata$,pos1%+1, pos2%-1) ! isolate number
select http_rc$ !
case "200" !
print "-i-HTTP "+ http_rc$;" (good)" !
score% = score% + 1 !
case else !
print "-e-HTTP "+ http_rc$;" (bad)" !
result$ = "-f-x-communications error" ! this is a fatal error
sanity_comm_error% = sanity_comm_error% + 1 ! this counter is resettable
if sanity_comm_error% >= 5 then !
print "-e-f- there were too many COMM ERRORS" !
goto fini_error ! GET OPERATOR'S ATTENTION
end if !
end select !
junk$ = edit$(recvdata$,32) ! upcase everything for FAULT test
if pos(junk$,":FAULT",1) > 0 then !
if wsdl_flag% = 1 then !
score% = score% + 1 !
print "-w-string :FAULT was detected (okay since WSDL=1)" !
else !
print "-w-string :FAULT was detected (bad since WSDL=0)" !
end if !
else !
print "-i-string :FAULT was not detected (good)" !
score% = score% + 1 !
end if !
else ! no HTTP
print "-e-oops, an HTTP repsonse was not detected" !
print "-e-oops, an HTTP repsonse was not detected" !
print "-e-oops, an HTTP repsonse was not detected" !
end if !
select score% !
case 0 !
print "-e-oops, this did not go well (score=0)" !
case 1 !
print "-w-oops, this did not go well (score=1)" !
case else !
print "-w-final score looks good to me (score="+str$(score%)+")"
end select !
print "Caveat: this message only reflects the HTTP response"
print "===================================================="
!
!------------------------------------------------------------------------------------------------------------------------
! <<< close the connection >>>
!------------------------------------------------------------------------------------------------------------------------
close_the_connection:
select len( recvdata$ )
case 0
print "-e-oops, no data returned (something has gone horribly wrong)"
case < 25
print "-e-oops, too little data returned (something has gone wrong)"
end select
print "----------------------------------------------------------------------"
!
!========================================================================================================================
! <<< close the connection >>>
!
! close the connection gracefully (we can't deallocate the ccb until this is done)
!
! note: this routine must never clobber rc (because we may be closing due to an error)
!========================================================================================================================
print "-i-close_the_connection" !
stage% = 5 !
rc = nsr_tcp_clos(debug, ncv) !
gosub display_rc !
goto rc_exit if (rc and 7%) <> 1 !
!
stage% = 6 !
rc = nsr_tcp_free(debug, ncv) !
gosub display_rc !
goto rc_exit if (rc and 7%) <> 1 !
!
goto fini !
!
!------------------------------------------------------------------------------------------------------------------------
! <<< display return code after each call to the TELNET library >>>
!------------------------------------------------------------------------------------------------------------------------
display_rc:
if ((rc and 7%) <> 1%) or ! if not -s- (success) &
(debug >= 2) ! or tracing is enabled
then !
print " rc="+ str$(rc) +" -"+ mid$(k_alarm$, (rc and 7%)+1, 1) +"-stage:";stage%
end if !
return !
!========================================================================================================================
! entry: recvdata$
!========================================================================================================================
! HTTP/1.1 200 OK DATE: MON, 14 NOV 2005 16:02:22 GMT SERVER: JETTY/4.2.9 (WINDOWS XP/5.1 X86 JAVA/1.3.1_08) CONNEC
! TION: CLOSE <?XML VERSION="1.0"?> <?XML-STYLESHEET TYPE="TEXT/XSL" HREF="XML/RESULTS.XSL"?> <RESULTSET FREEINSTAN
! CES="1" CALLSPENDING="0" SERVICEID="772FBA3D-BFA8-00C7-0054-9F94798845D4"> <CALLRESULT ID="14166988266" STATUS="E
! RROR.CONNECTION.SIP.0" DISCONNECTCODE="0" DISCONNECTREASON="UNKNOWN" STARTTIME="1131984082046" PLACECALLLATENCY="
! 55000" ENDTIME="1131984082046"> UNKNOWN </CALLRESULT> </RESULTSET><<<
!
declare long x%, y%, z% , ! &
string pattern$ , ! &
xml_result_id$ , ! &
xml_result_status$ , ! &
xml_disconnect_code$ , ! &
xml_disconnect_reason$ !
!
breakout_xml:
print "-i-entering breakout_xml"
!
xml_result_id$ = "" ! init
xml_result_status$ = "" !
xml_disconnect_code$ = "" ! only seen when there was a problem
xml_disconnect_reason$ = "" ! only seen when there was a problem
!
pattern$ = '<CALLRESULT ' !
x% = pos(recvdata$, pattern$, 1) ! this will always point to the start of our data
goto breakout_xml_exit if x% = 0 !
!
pattern$ = 'ID="' !
y% = pos(recvdata$, pattern$, x%) ! this will always point to the start of our data
goto breakout_xml_exit2 if y% = 0 !
y% = y% + len(pattern$) !
z% = pos(recvdata$, '"', y%) !
goto breakout_xml_exit2 if z% = 0 !
xml_result_id$ = seg$(recvdata$,y%,z%-1) !
!
pattern$ = 'STATUS="' !
y% = pos(recvdata$, pattern$, x%) ! this will always point to the start of our data
goto breakout_xml_exit2 if y% = 0 !
y% = y% + len(pattern$) !
z% = pos(recvdata$, '"', y%) !
goto breakout_xml_exit2 if z% = 0 !
xml_result_status$ = seg$(recvdata$,y%,z%-1) !
!
pattern$ = 'DISCONNECTCODE="' !
y% = pos(recvdata$, pattern$, x%) ! this will always point to the start of our data
goto breakout_xml_exit2 if y% = 0 !
y% = y% + len(pattern$) !
z% = pos(recvdata$, '"', y%) !
goto breakout_xml_exit2 if z% = 0 !
xml_disconnect_code$ = seg$(recvdata$,y%,z%-1) !
!
pattern$ = 'DISCONNECTREASON="' !
y% = pos(recvdata$, pattern$, x%) ! this will always point to the start of our data
goto breakout_xml_exit2 if y% = 0 !
y% = y% + len(pattern$) !
z% = pos(recvdata$, '"', y%) !
goto breakout_xml_exit2 if z% = 0 !
xml_disconnect_reason$ = seg$(recvdata$,y%,z%-1) !
!
breakout_xml_exit2:
print "-i-xml_result_id$ "; xml_result_id$ !
print "-i-xml_result_status$ "; xml_result_status$ !
print "-i-xml_disconnect_code$ "; xml_disconnect_code$ !
print "-i-xml_disconnect_reason$ "; xml_disconnect_reason$ !
!
breakout_xml_exit: !
print "-i-leaving breakout_xml" !
return
!-----------------------------------------------------------------------
! HACK MENU
!-----------------------------------------------------------------------
hack_menu:
hack_soap_action$ = "" ! init
hack_url_patch$ = "" !
if hack_service$ = "" then !
print "-w-hack_service$ is blank so skipping hack menu" !
goto hack_menu_exit !
end if !
!
print "hack menu" !
print "=========" !
print "0 - original implementation (works with gSOAP)" !
print "1 - send empty SOAPaction" !
print "2 - stuff '"+ hack_service$ +"' into SOAPaction" !
print "3 - stuff '/"+ hack_service$ +"' into SOAPaction (needed for some servers)"
print "4 - stuff 'urn:"+ hack_service$ +"' into SOAPaction" !
print "5 - append ' "+ hack_service$ +"' onto URL" !
print "6 - append '?"+ hack_service$ +"' onto URL" !
print "7 - append '/"+ hack_service$ +"' onto URL (only works with AXIS2)"
print "choice? (0-7, default=3) "; !
input junk$ !
junk$ = edit$(junk$,32) !
select junk$ !
case "0" ! do nothing
print "-i-no patch data applied" !
case "1" !
hack_soap_action$ = 'SOAPAction: ""' +cr+lf !
hack_url_patch$ = "" !
case "2" !
hack_soap_action$ = 'SOAPAction: "'+ hack_service$ +'"' +cr+lf !
hack_url_patch$ = "" !
case "3","" !
hack_soap_action$ = 'SOAPAction: "/'+ hack_service$ +'"' +cr+lf !
hack_url_patch$ = "" !
print "-i-defaulting to patch 3" !
case "4" !
hack_soap_action$ = 'SOAPAction: "urn:'+ hack_service$ +'"' +cr+lf
hack_url_patch$ = "" !
case "5" !
hack_soap_action$ = "" !
hack_url_patch$ = " "+ hack_service$ !
case "6" !
hack_soap_action$ = "" !
hack_url_patch$ = "?"+ hack_service$ !
case "7" !
hack_soap_action$ = "" !
hack_url_patch$ = "/"+ hack_service$ !
case else !
print "-e-bad choice" !
goto hack_menu !
end select !
hack_menu_exit: !
return !
!
!########################################################################################################################
!
! <<< Appended Function Area >>>
!
!========================================================================================================================
! <<< adios >>>
!========================================================================================================================
31000 fini: !
rc = 1 ! VMS-S-
goto fini_common !
!
fini_error: !
rc = 2 ! VMS-E-
goto fini_common !
!
! rc must be set up before this point
!
rc_error_exit: !
rc_exit: !
junk% = nsr_tcp_clos(0, ncv) ! blind close
junk% = nsr_tcp_free(0, ncv) ! blind free
!
fini_common:
end program rc ! return code to caller
!########################################################################################################################
!
! <<< appended functions >>>
!
32000 %include "[.fun]wcsm_dt_stamp.fun" ! 14 digit time stamp
!
32010 %include "[.fun]wcsm_trnlnm.fun" ! 16 digit time stamp
! external function string WCSM_TrnLnm (logical_name$, table_name$)
!
!========================================================================================================================
! wcsm_dt_stamp_alt
! exit: ccyymmdd.hhmmss
!========================================================================================================================
32020 function string wcsm_dt_stamp_alt !
option type=explicit !
external string function wcsm_dt_stamp !
declare string snap_shot$ !
!
snap_shot$ = wcsm_dt_stamp ! get snap shot of time
wcsm_dt_stamp_alt = left$(snap_shot$,8) +"."+ right$(snap_shot$,9) !
end function !
!
!========================================================================================================================
! Title : ascii dump
! Author : Neil Rieck
!========================================================================================================================
32030 sub ascii_dump (string pi_data$) !
option type=explicit !
!
declare string constant k_hex = "0123456789abcdef"
declare long i,j,k, &
sixteens, &
ones, &
junk, &
string pi_copy$, &
my_seg$, &
my_char$
!
margin #0, 90 !
pi_copy$ = pi_data$ ! copy inbound data
!
print "------------------------------------------------------------+---------------------"
print "00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 | 01234567890123456789"
print "------------------------------------------------------------+---------------------"
loop:
if len(pi_copy$) > 20 then
my_seg$ = left$(pi_copy$,20)
pi_copy$ = right$(pi_copy$,21)
else
my_seg$ = pi_copy$
pi_copy$ = ""
end if
!
! dump a line in HEX
!
j = 0 !
for i = 1 to len(my_seg$) !
my_char$ = mid$(my_seg$,i,1) ! isolate the character
junk = asc(my_char$) ! get the ASCII value
sixteens = junk / 16 !
ones = junk - (sixteens * 16) !
print mid$(k_hex,sixteens+1,1);mid$(k_hex,ones+1,1);" "; !
j = j + 3 ! update character length of current line
select junk !
case < 32, > 127 ! if control character
mid$(my_seg$,i,1) = "." !
end select !
next i !
print string$(60-j, asc(" ")); if j<60 ! pad short lines
print "| ";my_seg$ !
goto loop if len(pi_copy$) > 0 ! go back for more
end sub !
!=======================================================================
! ip4v_to_string
32040 !=======================================================================
function string ipv4_to_string(long ipv4) !
option type=explicit !
record twoway !
variant
case
group zero
string hack = 4
end group zero
case
group one
long ip4v_address
end group one
end variant
end record twoway !
!
declare twoway hack
declare long i,j
declare string temp$
!
hack::ip4v_address = ipv4 ! xfer to overlay
temp$ = "" ! init
for i = 4 to 1 step -1 ! scan
j = ascii( mid$(hack::hack,i,1)) !
temp$ = temp$ + str$(j) !
temp$ = temp$ + "." if i <> 1 !
next i !
ipv4_to_string = temp$ ! xfer data back
end function !
!========================================================================================================================
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.