OpenVMS Source Code Demos
ICSIS_TO_POP3_INTERFACE.BAS
1000 %title "ICSIS_TO_POP3_INTERFACE_100"
%ident "version_102.1" ! <<<---***
declare string constant k_version = "102.1" , ! &
k_program = "ICSIS_TO_POP3_INTERFACE" !
!=========================================================================================================================
! Title : ICSIS_to_POP3_INTERFACE_xxx.BAS !
! Author : Neil Rieck
! Purpose: reading mail messages stored in an POP3 server on port 110
! Notes : 1. by declaring the passing mechanisms in the external statements, it seems that we don't need to use
! VAX-BASIC's LOC() statement to substitute for an ampersand (address ref) in DEC-C and VAX-C
! 2. this program must be built (from DCL) as follows:
! $ basic file.bas
! $ link file, sys$input/options
! tcpware:tellib/lib
! sys$share:tcpware_socklib_shr/share
!=========================================================================================================================
! History:
! ver who when what
! --- --- ------ ---------------------------------------------------------------------------------------------------------
! 100 NSR 090426 1. original program (with hard coded test messages)
! 090427 2. added support for more POP3 verbs
! 3. added more code for data extraction
! 101 NSR 090510 1. tweaked before placing in public domain
! 102 NSR 090510 1. tweaked for Bell use
!=========================================================================================================================
option type = explicit ! no kid stuff...
set no prompt !
!
! constants
!
declare word constant k_recv_size_w = 4096 !
declare word constant k_xmit_size_w = 1024 !
declare long constant k_list_size = 100 !
!
! system declarations
!
%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$
%include "$secdef" %from %library "sys$library:basic$starlet" ! sec$
%include "$libdtdef" %from %library "sys$library:basic$starlet" ! eg. LIB$K_DELTA_SECONDS_F
%include "$libdef" %from %library "sys$library:basic$starlet" ! eg. lib$_normal
%include "$jpidef" %from %library "sys$library:basic$starlet" ! jpi$
%include "[.inc]VMS_Structures.inc" ! IOSB recs etc.
!
! home brewed functions
!
external string function wcsm_trnlnm (string, string) !
external string function wcsm_dt_stamp !
external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR
external string function format_dt !
!
map (neil) long icsis_debug% ! this map also appears in the sub proc
declare long rc% ,! return code &
i% ,! &
list% ,! &
ptr% ,! &
x% ,! &
stage% ,! for flow tracing &
ccb% ,! connection control block &
sleep_counter% ,! time stamp period &
timer_event_flag% ,! timer event flag &
timer_ef_state% ,! timer event flag state &
tcp_event_flag% ,! tcp event flag &
tcp_ef_state% ,! tcp event flag state &
mask% ,! required for sys$wflor &
dead_air_test% ,! &
try% ,! &
read_miss% ,! &
junk% ,! &
junk2% ,! &
channel_open% ,! &
cr% ,! &
lf% ,! &
start% ,! &
end1% ,! &
end2% ,! &
request_coldstart% ,! &
fail_safe% ,! &
error_handler% ,! when error test &
buff_len% ,! total len of buff &
read_only% ,! open read only &
buff_start% ,! start of mlr &
buff_end% ,! end of mlr &
buff_next_start% ,! start of mlr &
buff_next_end% ,! end of mlr &
field_name% ,! count fields &
file108_open% ,! &
connected_once% ,! &
word recvlen_w% ,! &
sendbuf_w% ,! &
my_port_w% ,! &
received_bytes_waiting_w% ,! &
string default_node$ ,! &
msg$ ,! &
msg_previous$ ,! &
src_node$ ,! &
dest_node$ ,! &
dest_port$ ,! &
user_name$ ,! &
pass_word$ ,! &
target_id$ ,! logical &
temp$ ,! &
junk$ ,! &
msg_num$ ,! &
my_date$ ,! &
default_dir$ ,! default dir &
wrkg_buff$ ,! working buffer &
collapsed$ ,! collapsed buffer &
choice$ ,! pick a command &
list$(k_list_size) ,! &
basic$QuadWord DeltaQuad ! for sys$bintim etc.
!
declare rfa rfa96 !
!
map(POP3)string ! &
sendbuf$ = k_xmit_size_w , ! &
recvbuf$ = k_recv_size_w !
!
declare string constant dq = '34'C ! double quote (ascii 34)
!
! <<< TCPware definitions >>>
!
%include "[.inc]tcpware_ccb_definitions.inc" ! ccb definitions
!
external long function tel_allocate_ccb( long by ref , ! ccb-ptr &
word by ref , ! rcv-buf-size &
word by ref ) ! snd-buf-size
!
external long function tel_get_ccb( long by ref , ! ccb-ptr &
word by ref , ! field-code &
any by ref ) ! value
!
external long function tel_deallocate_ccb( long by ref ) ! ccb-ptr
!
external long function tel_close_connection( long by ref ) ! ccb-ptr
!
external long function tel_abort_connection( long by ref ) ! ccb-ptr
!
external long function tel_open_connection( long by ref , ! ccb-ptr &
long by ref , ! ia &
string by desc , ! host &
!~~~ long by ref , x cmd-rtn &
long by value , ! cmd-rtn &
long by ref , ! efn &
long by ref , ! ast-addr &
word by ref , ! port &
long by ref ) ! timeout
!
external long function tel_receive_data( long by ref , ! ccb-ptr &
word by ref , ! buffer-size &
string by ref , ! buffer &
word by ref ) ! byte-count
!
external long function tel_send_data( long by ref , ! ccb-ptr &
string by ref , ! buffer &
word by ref ) ! byte-count
!
external long function tel_send_command( long by ref , ! ccb-ptr &
string by ref , ! buffer &
word by ref ) ! byte-count
!
!==========================================================================================
!
! /// Jpi Setup ///
!
record JpiRec ! structure of Jpi Record
ItemRec ItemVar(0) ! 0 -> 0 items
long list_term ! mark end-of-list
end record JpiRec !
!
declare JpiRec JpiBuf ! Now declare a variable using it
!
! Storage for info returned by GETJpi
!
MAP(Jpi)string ProcName = 15 , ! process name &
long ProcName_L ! returned length of PROC NAME
!
!========================================
! Make JpiBuf Entries
!========================================
!
JpiBuf::ItemVar(0%)::BuffLen = 15 ! 4 bytes (1 long)
JpiBuf::ItemVar(0%)::ItemCode = Jpi$_Prcnam ! Process Name
JpiBuf::ItemVar(0%)::BuffAddr = LOC( ProcName) !
JpiBuf::ItemVar(0%)::RtnLenAdr = LOC( ProcName_L) !
!
JpiBuf::LIST_TERM = Jpi$C_ListEnd ! end of list
!
!====================================================================================================
! main
!====================================================================================================
main:
margin #0, 132 ! width for the log file
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) ! underline previous line (how will this optimize?)
print "-i-time: "+ format_dt( wcsm_dt_stamp ) !
icsis_debug% = 0 ! init
connected_once% = 0 !
request_coldstart% = 0 !
!
when error in !
print "==================================================" !
print "You have 5 seconds to answer the next question" !
print "(on timeout, this program will use logical ICSIS_TO_POP3_DEBUG)"
print "Debug Menu:" !
print " 0 = only errors" !
print " 1 = errors + informationals" !
print " 2 = full" !
wait 5% !
input "Enter Debug Level? (0-2, defaults to 0) "; temp$ !
error_handler% = 0 !
use !
print "-i- timer expired" !
temp$ = edit$( WCSM_TrnLnm( "ICSIS_TO_POP3_DEBUG", "LNM$SYSTEM_TABLE" ),32+4+2)
end when !
!
! note: some debug logicals use YES/NO so we'll support this as well as numbers
!
select left$(temp$,1) ! YES -> Y
case "Y" !
temp$ = "2" !
case "N" !
temp$ = "0" !
end select !
when error in !
icsis_debug% = integer(temp$) !
use !
icsis_debug% = 0 !
end when !
print "-i- program Started with a Debug Level of "; icsis_debug% !
!
rc% = sys$GetJpiW(,0%,,JpiBuf,,,) ! get our process name
print "-e- GetJpiW rc: "+ str$(rc%) if ((rc% and 7%) <> 1) !
print "-i- ProcName: "+ left$(ProcName,ProcName_L) !
!
!====================================================================================================
!
! <<< restart connection >>>
!
restart_connection: !
dead_air_test% = 0 !
sendbuf$ = "" !
recvbuf$ = "" !
!
! <<< get some event flags for later >>>
!
if tcp_event_flag% = 0 then ! if not yet allocated
rc% = lib$get_EF( tcp_event_flag% ) ! get an event flag
if ((rc% and 7%) <> 1) then !
print "lib$get_EF-1 rc: ";str$(rc%) !
goto rc_exit !
end if !
end if !
!
! Implementation notes for lexical %hardened
!
! 0: original code
! only one event flag (tcp_event_flag%) is used to detect when data has arrived from the other end
! 1: hardened code
! two event flags are used:
! 1. one event flag (tcp_event_flag%) is used to detect when data has arrived from the other end
! 2. a second event flag (timer_event_flag%) is used to determine when a no activity timer has expired
!
%let %hardened=1% ! 0=original code, 1=hardened code
%if %hardened=1% %then ! hardened code -----------------------------------
if timer_event_flag% = 0 then ! if not yet allocated
rc% = lib$get_EF( timer_event_flag% ) ! get another event flag
if ((rc% and 7%) <> 1) then !
print "lib$get_EF-2 rc: ";str$(rc%) !
goto rc_exit !
end if !
end if !
%end %if ! -------------------------------------------------
!
! have the system allocate a connection control block and save the address in ccb%
!
if ccb% = 0 then ! if not yet allocated
declare string constant k_stage1 = ">>> tel func: allocate" !
stage% = 1 !
print k_stage1 if icsis_debug% >= 2 !
rc% = tel_allocate_ccb( ccb%, k_recv_size_w, k_xmit_size_w ) ! allocate a ccb and then address in ccb%
gosub display_rc !
goto rc_exit if (rc% and 1%) <> 1% ! this may be too drastic ???
end if !
!
! <<< open a connection >>>
!
declare string constant k_stage3 = ">>> tel func: open" !
stage% = 3% !
print k_stage3 if icsis_debug% >= 2 !
src_node$ = edit$( WCSM_TrnLnm( "TCPIP_DOMAINNAME", "LNM$SYSTEM_TABLE" ),32+4+2)
dest_node$ = "127.0.0.1" !
dest_port$ = "110" !
!
print "-i- src node : ";src_node$ !
print "-i- dest node : ";dest_node$ !
print "-i- port : ";dest_port$ !
my_port_w% = integer(dest_port$) ! prep for open
!
! note: this isn't stated in the manual, but you'll get an error if timeout isn't >=20 or 0
!
rc% = tel_open_connection( &
ccb% ,! ccb-ptr &
,! ia (use IA or HOST, not both) &
dest_node$ ,! host (use IA or HOST, not both) &
,! cmd-rtn must leave blank for NONE &
tcp_event_flag% ,! efn &
,! ast-addr must leave blank for NONE &
my_port_w% ,! port (7=echo, 23=telnet , 25=smtp, 110=pop3) &
20% ! timeout in seconds &
)
gosub display_rc !
if (rc% and 1%) <> 1% then !
goto close_connection !
end if !
channel_open% = 1 !
!
try% = 1 ! init to stage 1 (nothing to send...
goto wait_for_response ! ...so just wait for the open message)
!
! <<< send the data (loop) >>>
!
send_data_loop: !
declare string constant k_stage4 = ">>> tel func: send data" !
stage% = 4% !
print k_stage4 if icsis_debug% >= 2 !
print "-i- time: "+ format_dt( wcsm_dt_stamp ) +" -------------->>> doing try: "+ str$(try%)
select try% !
case 1 ! place-holder (initial wait for response)
goto wait_for_response !
case 2 ! send user
msg$ = "USER esppats" + cr + lf !
case 3 ! send password
msg$ = "PASS whatever" + cr + lf !
case 4 ! send STAT
msg$ = "STAT" + cr + lf ! this command isn't very useful
try% = try% + 1 ! prep for next step
goto send_data_loop !
case 5 ! send LIST
msg$ = "LIST" + cr + lf !
case 6 ! RETR
ptr% = ptr% + 1 !
if ptr% > list% then ! if done
try% = 99 ! then prep for QUIT
goto send_data_loop !
else !
! <<< Example data >>>
! +OK 6 messages (5334 octets)
! 1 889
! 2 889
! 3 889
! 4 889
! 5 889
! 6 889
junk% = pos(list$(ptr%)," ",0) ! look for first <sp>
if junk% <= 1 then ! this should never happen
print "-e- logic error 123 so exiting" !
else !
msg_num$ = left$(list$(ptr%), junk%-1) ! extract message number
end if !
msg$ = "RETR "+ msg_num$ + cr + lf !
end if !
case 7 ! delete messages
try% = 6 !
goto send_data_loop ! <<<< do not delete just now
msg$ = "DELE "+ junk$ + cr + lf !
case 8 ! delete messages
try% = 99 !
goto send_data_loop !
case 99 ! delete messages
msg$ = "QUIT"+ cr + lf !
case 100 !
print "===================================" !
print "the POP3 comm process was successul" !
print "===================================" !
goto close_connection !
case else ! shouldn't ever happen...
print " (???) oops!" !
goto close_connection !
end select !
sendbuf$ = msg$ !
sendbuf_w% = len(msg$) !
print "-i- xmit data>";msg$;"<" if icsis_debug% >= 1 !
rc% = tel_send_data ( ccb%, sendbuf$, sendbuf_w% ) !
gosub display_rc !
goto close_connection if (rc% and 1%) <> 1% !
!
!----------------------------------------------------------------------------------------------------
! data has now been sent so we'll wait for an event flag
!----------------------------------------------------------------------------------------------------
wait_for_response:
declare string constant k_stage5 = ">>> tel func: wait"
stage% = 5%
print k_stage5 if icsis_debug% >= 2
%if %hardened=0% %then ! original code ---------------------------
!
! <<< wait for the TCP event flag to change state >>>
!
if icsis_debug% >= 1 then !
print "-i- waiting for flag ";tcp_event_flag%;" at time: "+ format_dt( wcsm_dt_stamp )
end if !
rc% = sys$waitfr( tcp_event_flag% ) ! wait for a response from a single flag
gosub display_rc !
goto close_connection if (rc% and 1%) <> 1% !
if icsis_debug% >= 1 then !
print "-i- waking from event flag "+ str$(tcp_event_flag%) +" at time: "+ format_dt( wcsm_dt_stamp )
end if !
%else ! hardened code ---------------------------
!
! <<< arm a timer to expire 'x' time from now >>>
!
declare string constant k_delay010 = "0 00:00:10" ! set delay time 10 seconds from now
rc% = sys$bintim(k_delay010, DeltaQuad ) ! init delta time ('x' time from now)
print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
rc% = sys$setimr(timer_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up
print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
! The first parameter is only used to determine which event flag cluster to test.
! The second parameter (mask) contains bits representing event flags within that cluster
!
mask% = get_timer_bit_vector( tcp_event_flag%) ! insert vector 1 into mask
mask% = mask% or get_timer_bit_vector(timer_event_flag%) ! insert vector 2 into mask
!
! <<< wait for either the 'TCP event flag' or the 'TIMER event flag' to change state >>>
!
print "-i- waiting for flag ";tcp_event_flag%; " or flag "; timer_event_flag%; " time: "+ format_dt( wcsm_dt_stamp )
!
rc% = sys$wflor( tcp_event_flag%, mask%) ! wait for a response from one of two flags
print "-e- sys$waitfr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
gosub display_rc !
goto close_connection if (rc% and 1%) <> 1% !
if icsis_debug% >= 1 then !
print "-i- waking from event some flag at time: "+ format_dt( wcsm_dt_stamp )
end if !
!
! <<< cancel all timer requests (if any) >>>
!
print "-i- Calling $CanTim" !
rc% = sys$cantim(,) ! cancel all timer requests
print "-e- sys$cantim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! which event flag is set? TCP or TIMER?
!
rc% = sys$readEF(tcp_event_flag%, junk%) ! test TCP event flag
select rc% !
case SS$_WASCLR !
tcp_ef_state% = 0 !
case SS$_WASSET !
tcp_ef_state% = 1 !
case else !
print "-e- sys$readef-tcp rc: "+ str$(rc%) !
end select !
print "-i- TCP EF State: ";str$(tcp_ef_state%);" "; if icsis_debug% >= 1 ! no BASIC EOL required here
!
rc% = sys$readEF(timer_event_flag%, junk%) ! test TIMER event flag
select rc%
case SS$_WASCLR
timer_ef_state% = 0
case SS$_WASSET
timer_ef_state% = 1
case else
print "-e- sys$readef-timer rc: "+ str$(rc%)
end select
print "-i- Timer EF State: ";str$(timer_ef_state%) if icsis_debug% >= 1 !
!
! at this point either the TCP-EF or the TIMER-EF could be set
!
if (timer_ef_state% = 1) and ! if the TIMER-EF is set &
( tcp_ef_state% = 0) ! and the TCP-EF is clear
then ! then something timed out
select dead_air_test% !
case 0 ! if not doing a dead air test
print "-i- starting dead-air test" !
dead_air_test% = dead_air_test% + 1 ! ...then arm the test
goto send_data_loop ! ...now send a key stroke to View-1
case else
print "-e- ALERT: the dead-air test has failed. Starting a new connection cycle"
goto close_connection ! but need to disconnect first
end select
else ! we've got TCP data so fall thru
end if
%end %if ! hardened code ---------------------------
!
! <<< receive the data >>>
!
declare string constant k_stage6 = ">>> tel func: recv data"
stage% = 6%
print k_stage6 if icsis_debug% >= 2
!
read_miss% = 0% ! init
wrkg_buff$ = "" !
buff_len% = 0% !
!
! <<< read loop >>>
!
read_loop:
%let %method=3% ! we want method 3 bf_120.9
%if %method<1% %then
lexical %method value too low ! abort compile if too low
%end %if
%if %method>3% %then
lexical %method value too high ! abort compile if too high
%end %if
%if %method=1% %then ! using polling method (original code)
junk% = 1 ! start a read
%end %if !
%if %method=2% %then ! avoid polling via TEL_GET_CCB bf_120.7
!
! peek into the interface to see if any data is waiting in the receive buffer
!
! Note: this technique may not be reliable since we've recently seen conditions where the event flag remains set
! even though 'bytes waiting' is set to zero. (Could this happen when an EOL character is stuck in the interface?)
!
rc% = tel_get_ccb( ccb%, CCB_RCVBCNT, received_bytes_waiting_w% ) ! bf_120.7
gosub display_rc !
print "-i- ccbRcvbcnt: "+str$(received_bytes_waiting_w%) if icsis_debug% >= 1 !
junk% = received_bytes_waiting_w% !
%end %if
%if %method=3% %then ! avoid polling via SYS$ReadEF
!
! Note: since the event flag will be set when ever data is available, this is probably the best technique to
! use other than polling via the call to TEL_READ_DATA
!
rc% = sys$readEF(tcp_event_flag%, junk%) ! test TCP event flag bf_120.9
select rc%
case SS$_WASCLR
tcp_ef_state% = 0 ! data not available
case SS$_WASSET
tcp_ef_state% = 1 ! data is available
case else
print "-e- sys$readef-tcp rc: "+ str$(rc%)
end select
junk% = tcp_ef_state% !
%end %if
select junk% ! any data available?
case 0 ! no...
recvlen_w% = 0 ! indicate that no data was received
case else ! yes...
!
! read data from the TCP buffer
!
! Note: we get here via a test of TEL_GET_CCB to avoid polling with TEL_RECEIVE_DATA.
! See page 9-16 of the TCPware programmer's manual for details
!
rc% = tel_receive_data( ccb%, k_recv_size_w, recvbuf$, recvlen_w%) ! receive data <<<------***
select rc% !
case SS$_VCCLOSED, SS$_TIMEOUT, SS$_THIRDPARTY ! bf_123.1
print "-w- connection closed unexpectedly ("+str$(rc%)+")" !
goto close_connection ! cleanup etc.
case else !
gosub display_rc !
goto close_connection if (rc% and 1%) <> 1% !
end select !
!
if icsis_debug% >= 2 then !
print "-i- recv data >"+ left$(recvbuf$, recvlen_w%);"<" !
print "-i- recv count: "+ str$(recvlen_w%) !
end if !
end select !
!
print "-i- read miss : "+ str$(read_miss%) if icsis_debug% >= 1 !
if recvlen_w% > 0% then ! we've got some data...
read_miss% = 0% ! ...so prep to continue (not a miss)
wrkg_buff$ = wrkg_buff$ + left$(recvbuf$, recvlen_w%) ! concat recv data into holding buffer
goto read_loop ! loop back for more
else ! we didn't get any data...
read_miss% = read_miss% + 1% ! so up the read miss count
sleep 1 ! kill some time
goto read_loop if read_miss% <= 1 ! loop if less than 2 seconds
end if !
!
if icsis_debug% >= 1 then !
print "-i- ============================================================" !
print "-i- wkg buffer len:"+str$(len(wrkg_buff$)) !
print "-i- wkg buffer>"; wrkg_buff$;"<" !
print "-i- try: "+ str$(try%) !
print "-i- ============================================================" !
end if !
!
collapsed$ = edit$( wrkg_buff$, 128+32+16+8) ! cleanup for testing
junk% = pos( collapsed$ , "-ERR", 1) !
goto fini if junk% = 1 ! this is a demo so just exit on error
!
select try% !
case 1 !
goto fini if len(collapsed$) = 0 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case 2 ! USER
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case 3 ! PASS
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case 4 ! STAT
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case 5 ! LIST
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
!
list% = 0 ! init line counter
start% = 0 ! init starting position
scan_more5: !
cr% = pos(wrkg_buff$, cr, start%+1) ! find position of <cr> (usually is first)
lf% = pos(wrkg_buff$, lf, start%+1) ! find position of <lf> (usually is second)
if cr% > 0 and lf% > 0 then ! if we've got a pair
end1% = min(cr%,lf%) !
end2% = max(cr%,lf%) !
else !
end1% = 0 ! init
end1% = cr% if cr% > 0 !
end1% = lf% if lf% > 0 !
end2% = end1% !
end if !
if end1% > 0 then !
goto no_more_room if list% >= k_list_size !
junk$ = seg$(wrkg_buff$, start%+1, end1%-1) !
if junk$ <> "." then ! if not end-of-list indicator
list% = list% + 1 ! prep for insert
list$(list%) = seg$(wrkg_buff$, start%+1, end1%-1) !
end if !
start% = end2% !
goto scan_more5 !
end if !
no_more_room: !
print "-i- dumping contents of message list" !
for ptr% = 1 to list% !
print "-i-debug Line: "+ str$(ptr%) + " len: "+ str$(len(list$(ptr%))) +" msg: "+ list$(ptr%)
next ptr% !
select list% !
case <= 1 ! line #1 = "+OK x messages (xxx octects)"
try% = 99 ! prep for QUIT
case else !
ptr% = 1 !
try% = try% + 1 ! prep for RETR
end select !
goto send_data_loop !
case 6 ! RETR
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
print "1>"+ wrkg_buff$ +"<2" !
!
! prep to discard the first line
!
cr% = pos(wrkg_buff$, cr, start%+1) ! find position of <cr> (usually is first)
lf% = pos(wrkg_buff$, lf, start%+1) ! find position of <lf> (usually is second)
if cr% > 0 and lf% > 0 then ! if we've got a pair
end1% = min(cr%,lf%) !
end2% = max(cr%,lf%) !
else !
end1% = 0 ! init
end1% = cr% if cr% > 0 !
end1% = lf% if lf% > 0 !
end2% = end1% !
end if !
print "3>"+ right$(wrkg_buff$,end2%+1) +"<4" !
print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
try% = try% + 1 !
goto send_data_loop !
case 7 ! DELE
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case 99 ! QUIT
junk% = pos( collapsed$ , "+OK", 1) !
goto fini if junk% <> 1 ! this is a demo so just exit on error
try% = try% + 1 !
goto send_data_loop !
case else !
goto fini ! exit for now (dvlp)
end select !
!
! <<< close the connection >>>
!
close_connection: !
gosub close_telnet_connection !
goto fini !
!
! <<< close telnet connection subroutine >>>
!
close_telnet_connection: !
return if channel_open% = 0 !
declare string constant k_stage11 = ">>> tel func: close" !
stage% = 11% !
print k_stage11 if icsis_debug% >= 2 !
print "Closing connection..." !
rc% = tel_close_connection( ccb% ) ! this only closes my xmit...
gosub display_rc !
fail_safe% = 0 ! init fail safe counter
!
buffer_purge: !
print "-i- purging receive buffer <<<---***" if icsis_debug% >= 1 !
fail_safe% = fail_safe% + 1 !
junk% = tel_receive_data( ccb%, k_recv_size_w, recvbuf$, recvlen_w%) ! clean out receive buffer
print "-i- receive buffer purge. Bytes: "+ str$(recvlen_w%) +" rc: ";str$(junk%) if icsis_debug% >= 1
select junk% !
case SS$_VCCLOSED, SS$_TIMEOUT, SS$_THIRDPARTY ! now totally closed so fall thru
case else
if (junk% and 7%) = 1 then ! if no errors bf_125.4
junk% = sys$bintim("0 00:00:00.10", DeltaQuad ) ! then init delta time to 100 mS
junk% = sys$schdwk(,,DeltaQuad by ref,) ! schedule a wakeup ? seconds from now
junk% = sys$hiber ! go to sleep
goto buffer_purge if fail_safe% <= 50 ! loop back (5 second worse case limit)
junk% = tel_abort_connection( ccb% ) ! don't take any chances bf_122.8
sleep 5 ! bf_122.8
else ! some kind of error....
junk% = tel_abort_connection( ccb% ) ! don't take any chances
sleep 1 !
end if !
end select !
channel_open% = 0 !
return !
!----------------------------------------------------------------------------------------------------
!
! <<< display return code after each call to the TELNET library >>>
!
display_rc:
if (rc% and 7%) <> 1% or ! if not -s- (success) &
icsis_debug% >= 1% ! or debugging is enabled
then
select stage%
case 1%
print k_stage1;
case 3%
print k_stage3;
case 4%
print k_stage4;
case 5%
print k_stage5;
case 6%
print k_stage6;
case 11%
print k_stage11;
case else
print "Oops: ";
end select
!
print " >>> ";
select (rc% and 7%)
case 0%
print "-w-";
case 1
print "-s-";
case 2
print "-e-";
case 3
print "-i-";
case 4
print "-f-";
case else
print "-?-";
end select
print " rc: ";str$(rc%)
end if
return
!====================================================================================================
! <<< adios... >>>
!====================================================================================================
fini:
rc% = 1 ! vms -s-
!
! rc% must be set up b4 this point (and must not be changed)
!
rc_exit:
!
! pre-exit clenaup (optional stuff but let's do it anyway)
!
gosub close_telnet_connection ! bf_122.5
if ccb% <> 0% then !
junk% = tel_deallocate_ccb( ccb% ) !
print "-e- tel_deallocate_ccb rc: "+str$(junk%) if ((junk% and 7%) <> 1)
end if !
if tcp_event_flag% <> 0 then !
junk% = lib$free_EF( tcp_event_flag% ) ! free the event flag
print "-e- lib$free_EF-tcp rc: "+str$(junk%) if ((junk% and 7%) <> 1)
end if !
%if %hardened=1% %then ! hardened code ---------------------------
if timer_event_flag% <> 0 then !
junk% = lib$free_EF( timer_event_flag% ) ! free the event flag
print "-e- lib$free_EF-timer rc: "+str$(junk%) if ((junk% and 7%) <> 1)
end if !
%end %if ! -----------------------------------------
!
30000 end program rc%
!
!========================================================================================================================
! external functions
!========================================================================================================================
31010 %include "[.fun]wcsm_trnlnm.fun"
! FUNCTION STRING WCSM_TRNLNM(LOGICAL_NAME, TABLE_NAME$)
!
31020 %include "[.fun]wcsm_dt_stamp.fun"
! FUNCTION STRING wcsm_dt_stamp
!
31030 function string format_dt(string inbound$) !
option type=explicit !
select len(inbound$) !
case 12 to 14 ! eg. CCYYMMDDhhmm or CCYYMMDDhhmmss
format_dt = left$(inbound$,8) +"."+ right$(inbound$,9) !
case 15 ! eg. CCYYMMDDhhmmsst
format_dt = left$(inbound$,8) +"."+ mid$(inbound$,9,6) + ! &
left$(inbound$,15) !
case else !
format_dt = inbound$ !
end select !
end function !
!
!======================================================================
! get timer bit vector
! (see OpenVMS system systevices documentation for "sys$wflor")
!
! notes: cluster event flags
! 0 00- 31
! 1 32- 63
! 2 64- 95
! 3 96-127
!======================================================================
31040 function long get_timer_bit_vector(long event_flag)
option type = explicit
declare long temp
!
select event_flag
case <= 31
temp = event_flag
case <= 63
temp = event_flag - 32
case <= 95
temp = event_flag - 64
case else
temp = event_flag -96
end select
!
select temp ! this code will avoid an integer overflow
case 31 ! need to set bit #31
! 33222222222211111111110000000000
! 10987654321098765432109876543210
get_timer_bit_vector = B"10000000000000000000000000000000"L ! so return this
case else !
get_timer_bit_vector = (2% ^ temp) ! else return this
end select
!
end function ! get_timer_bit_vector
!
!####################################################################################################
!
! KAWC09::Neil> telnet 127.0.0.1 110
! %TCPWARE_TELNET-I-TRYING, trying localhost,pop3 (127.0.0.1,110) ...
! %TCPWARE_TELNET-I-ESCCHR, escape (attention) character is "^\"
! USER esppats
! +OK Password required for "esppats"
! PASS whatever
! +OK Username/password combination ok
! STAT
! +OK 2 478
! LIST
! +OK 2 messages (478 octets)
! 1 239
! 2 239
! .
! RETR 1
! +OK 239 octets
! Date: 27-APR-2009 13:22:14.89
! From: <neil@kawc09>
! Subject: this is a test
! Cc:
! To: ESPPATS
! X-VMS-From: KAWC09::NEIL
! X-POP3-Server: kawc09.on.bell.ca TCPware(R) POP3 V5.8-2
! X-POP3-ID: 2009-04-27.13:27:57.0
!
! this is test 1
!
! .
! DELE 1
! +OK Message 1 has been deleted.
! STAT
! +OK 1 239
! LIST
! +OK 1 messages (239 octets)
! 2 239
! .
! DELE 2
! +OK Message 2 has been deleted.
! STAT
! +OK 0 0
! LIST
! +OK 0 messages (0 octets)
! .
!
!----------------------------------------------------------------------------------------------------
! KAWC09::Neil> telnet 127.0.0.1 110
! %TCPWARE_TELNET-I-TRYING, trying localhost,pop3 (127.0.0.1,110) ...
! %TCPWARE_TELNET-I-ESCCHR, escape (attention) character is "^\"
! +OK TCPware(R) POP3 server V5.8-2 at kawc09.on.bell.ca, up since 2009-04-27 12:22:43
! USER esppats
! +OK Password required for "esppats"
! PASS whatever
! +OK Username/password combination ok
! LIST
! +OK 2 messages (466 octets)
! 1 233
! 2 233
! .
!
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.