Next: webrti.frm
Up: Code Listing
Previous: utility.bas
'
' Author: Terence Kelly
' Date: 8 September 1995
'
' The .EXE program resulting from this module will be invoked by
' an HTTPD server and will handle instructions from the Web
' client. Possible instructions include: produce digital or
' analog outputs via the RTI, communicate with the Tektronix 222,
' and return data and messages to the client.
'
' This module must never cause a window or icon to appear on
' the server screen. It must do its thing invisibly.
' It must handle run-time errors intelligently and prevent the
' appearance of windows. See the documentation on Bob Denny's
' WinHTTPD server, the RTI-815 board, and the Tektronix 222 scope
' for details.
'
' Records basic usage info
Global Const RTILog$ = "C:\HTTPD\LOGS\WEBRTI.LOG"
' Server-end home of log files, etc.
Global Const RTIDir$ = "C:\HTTPD\HTDOCS\WEBRTI\"
' Client's view of RTIDir$
Global Const HREF$ = "http://piper.princeton.edu/webrti/"
' Pointers to individual scope dumps
Global Const TekLog$ = "TEK.HTM"
' This executable simply deletes all .LOG files from session log
' directory.
Global Const Purge$ = "http://piper.princeton.edu/cgi-win/purgelog.exe"
Global Const MAX_RECURSIONLEVEL% = 20
Global Const MAX_LOOPITERATIONS% = 100
' If the following file exists, WEBRTI will refuse to run.
Global Const Lockfile$ = "C:\HTTPD\HTDOCS\WEBRTI\WEBRTI.LOK"
' Global variables used in error logging and execution tracking due
' to "recursive" nature of execution flow: ability to "SOURCE" a
' server-end file containing a command string (which can itself
' contain SOURCE commands) means we ought to track flow of execution
' carefully.
Global SessionLog As String ' Detailed info on an individual run
Global CommandNumber As Long ' Never decremented. Keeps track of
' non-null commands.
Global RecursionLevel As Integer ' Program submitted by client is at
' RecursionLevel zero. Commands in a
' file SOURCE'd by client program are
' at RecursionLevel 1; commands in
' file SOURCE'd by *that* file are
' at RecursionLevel 2, etc.
Global gstrLogString As String ' See "Exec" routine. For sake of
' efficiency, we accumulate log
' message in this string and write it
' to disk if it gets too big. This
' lets us avoid a disk write for
' every call of "Exec" and also
' should prevent "out of string
' space" crashes.
' Following code is by R. Denny, author of WinHTTPD
'--------------------------------------------------------------------
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpSection As \
String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal \
lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName \
As String) As Integer
Type Tuple ' Used for Accept: and "extra" headers
Key As String ' and for holding POST form key=value pairs
value As String
End Type
Const MAX_ACCTYPE = 100 ' Added by T. Kelly
Global CGI_ProfileFile As String ' Pathname of CGI Data File
Global CGI_AcceptTypes(MAX_ACCTYPE) As Tuple ' Accept: types array
Global CGI_NumAcceptTypes As Integer ' No. of Accept: types in array
Const ENUM_BUF_SIZE = 8192 ' Size of key enumeration buffer
' End of code from R. Denny
'---------------------------------------------------------------------
Sub Debug_Main ()
'
' Preliminary version of Main function. Returns to client lots
' of info available to server.
'
Dim strCmdLine As String
Dim strDataFile As String, strContentFile As String
Dim strOutputFile As String, strURLArgs As String
Dim Filenumber As Integer
T$ = "BEGIN Debug_Main " & Format(Now, "h:m:ss m/d/yy")
Call AppendToFIle(RTILog$, T$)
strCmdLine = Command$
strDataFile = Split(strCmdLine, 1, " ") ' See WinHTTPD docs for
strContentFile = Split(strCmdLine, 2, " ") ' explanation of these
strOutputFile = Split(strCmdLine, 3, " ") ' command-line arguments
strURLArgs = Split(strCmdLine, 4, " ")
CGI_ProfileFile = strDataFile ' Bob Denny's global variable
Filenumber = FreeFile
Open strOutputFile For Output As Filenumber
Print #Filenumber, "Content-type: text/html" & CRLF() & CRLF()
'
' Send stuff to the client using Print #Filenumber commands
' here. Be sure to send a valid HTML file.
'
Close #Filenumber
T$ = "END Debug_Main " & Format(Now, "h:m:ss m/d/yy")
Call AppendToFIle(RTILog$, T$)
End Sub
Sub Exec (ByVal S$)
'
' Execute an individual command. Global string is used to keep
' running track of commands executed so far and return values
' and error messages generated by those commands. If this string
' gets too large, it is written to the output file and re-set to
' empty string. This will hopefully avoid "out of string space"
' crashes because the string never gets very big. It also avoids
' inefficient strategy of writing to disk on every call to this
' routine.
'
CommandNumber = CommandNumber + 1 ' increment global count
' dump global log message string to file and clear it if it's
' too big
If Len(gstrLogString) > 4096 Then
Call AppendToFIle(RTIDir$ & SessionLog, gstrLogString)
gstrLogString = ""
End If
' convert nulls back to semicolons, undoing the work of routine
' LoopHack
CMD$ = StrSub(CondenseWhitespace(S$), Chr$(0), ";")
LogMsg$ = CRLF() & String$(RecursionLevel * 3, " ") ' indent for
' easy reading
LogMsg$ = LogMsg$ & Trim$(Str$(RecursionLevel)) & "/"
LogMsg$ = LogMsg$ & Trim$(Str$(CommandNumber))
LogMsg$ = LogMsg$ & " : " & CMD$ & " : "
gstrLogString = gstrLogString & LogMsg$
RV$ = ""
Select Case Split(CMD$, 1, " ")
Case "TEK"
SubCMD$ = Split(CMD$, 2, " ")
Select Case SubCMD$
Case "GET"
RV$ = Tek_get()
Case "SEND"
T1$ = Tek_send(Split(CMD$, 3, " "), Loopstring(CMD$))
T2$ = CondenseWhitespace(T1$)
RV$ = Tek_InsertErrorMsgs(Trim$(T2$))
Case "FP?"
RV$ = Tek_FP(Split(CMD$, 3, " "))
Case Else
RV$ = "unrecognized subcommand to TEK"
End Select
Case "DOT"
RV$ = RTI_Dot(Split(CMD$, 2, " "))
Case "DOTB"
RV$ = RTI_DotB(Split(CMD$, 2, " "), Split(CMD$, 3, " "))
Case "DIN"
RV$ = RTI_Din()
'
' DINB GOES HERE -- NOT YET IMPLEMENTED
'
Case "XAOT"
RV$ = RTI_Aot(Split(CMD$, 2, " "), Split(CMD$, 3, " "))
Case "XAIN"
RV$ = RTI_Ain(Split(CMD$, 2, " "))
Case "SOURCE"
FN$ = RTIDir$ & Split(CMD$, 2, " ") & ".RTI"
FC$ = Filecontents(FN$)
If RecursionLevel >= MAX_RECURSIONLEVEL% Then
RV$ = "recursion level limit exceeded"
ElseIf FC$ <> "" Then
RecursionLevel = RecursionLevel + 1
Call Interp(FC$)
RecursionLevel = RecursionLevel - 1
Else
RV$ = "file empty or nonexistent: " & FN$
End If
Case "DELAY"
Call Delay(Val(Split(CMD$, 2, " ")))
Case "LOOP"
If NumOccur(CMD$, "{") <> 1 Or NumOccur(CMD$, "}") <> 1 Then
RV$ = "incorrect number of braces"
ElseIf Val(Split(CMD$, 2, " ")) > MAX_LOOPITERATIONS% Then
T$ = "loop iteration limit ("
RV$ = T$ & Str$(MAX_LOOPITERATIONS%) & ") exceeded"
ElseIf Val(Split(CMD$, 2, " ")) < 1 Then
RV$ = "numeric argument invalid or less than one"
Else
For I% = 1 To Val(Split(CMD$, 2, " "))
Call Interp(Loopstring(CMD$))
Next
End If
' following case should handle more commands from RTI
' software manual
Case "DINB", "OUTPUT"
RV$ = "Routine Exec reports: command not yet implemented"
Case Else
RV$ = "Unrecognized command passed to routine Exec"
End Select
gstrLogString = gstrLogString & RV$
End Sub
'
' Following code from R. Denny's WinHTTPD distribution.
'
'---------------------------------------------------------------------------
'
' GetAcceptTypes() - Create the array of accept type structs
'
' Enumerate the keys in the [Accept] section of the profile file,
' then get the value for each of the keys.
'---------------------------------------------------------------------------
Private Sub GetAcceptTypes ()
Dim sList As String
Dim I As Integer, J As Integer, l As Integer, n As Integer
sList = GetProfile("Accept", "") ' Get key list
l = Len(sList) ' Length incl. trailing null
I = 1 ' Start at 1st character
n = 0 ' Index in array
Do While ((I < l) And (n < MAX_ACCTYPE))' Safety stop here
J = InStr(I, sList, Chr$(0)) ' J -> next null
CGI_AcceptTypes(n).Key = Mid$(sList, I, J - I) ' Get Key, then value
CGI_AcceptTypes(n).value = GetProfile("Accept", CGI_AcceptTypes(n).Key)
I = J + 1 ' Bump pointer
n = n + 1 ' Bump array index
Loop
CGI_NumAcceptTypes = n ' Fill in global count
End Sub
'
' Following code from R. Denny WinHTTPD distribution.
'
'---------------------------------------------------------------------------
'
' GetProfile() - Get a value or enumerate keys in CGI_Data file
'
' Get a value given the section and key, or enumerate keys given the
' section name and "" for the key. If enumerating, the list of keys for
' the given section is returned as a null-separated string, with a
' double null at the end.
'
' VB handles this with flair! I couldn't believe my eyes when I tried
' this.
'---------------------------------------------------------------------------
Private Function GetProfile (sSection As String, sKey As String) As String
Dim retLen As Integer
Dim buf As String * ENUM_BUF_SIZE
If sKey <> "" Then
retLen = GetPrivateProfileString(sSection, sKey, "", buf, \
ENUM_BUF_SIZE, CGI_ProfileFile)
Else
retLen = GetPrivateProfileString(sSection, 0&, "", buf, \
ENUM_BUF_SIZE, CGI_ProfileFile)
End If
If retLen = 0 Then
GetProfile = ""
Else
GetProfile = Left$(buf, retLen)
End If
End Function
Sub Interp (ByVal S$)
'
' Interpret a string of commands and "execute" them by passing
' individual non - Null commands to Exec routine.
'
' Mismatched curly braces are such a scourge that we reject any
' commandstring unless curly braces match properly.
'
If NumOccur(S$, "{") <> NumOccur(S$, "}") Then
T$ = "Error in routine Interp: mismatched curly "
gstrLogString = T$ & "braces. Exiting." & CRLF()
Exit Sub
End If
' We should really condense whitespace in the command below,
' rather than in Exec, for efficiency.
NC$ = LoopHack(UCase$(NormalizeCommand(S$)))
For I% = 1 To NumOccur(NC$, ";") + 1
CMD$ = Trim$(Split(NC$, I%, ";"))
If CMD$ <> "" Then
Call Exec(CMD$)
End If
Next
End Sub
Function LoopHack (ByVal S$) As String
'
' Given a string, return a string identical to the original
' except that between curly braces semicolons are converted to
' null characters.
'
' We parse the command string by splitting on semicolons before
' dealing with loops. We want commands within a loop to be
' delimited by semicolons (to make life easier on users), but we
' don't want a loop command to be split on semicolons. So we
' use a hack: prior to parsing the commandstring, we replace
' semicolons with nulls. Later on, within function Exec, we
' reverse the substitution.
'
' Another use for this function is in dealing with multiple
' commands to send to the Tektronix scope. Multiple commands
' are delimited by semicolons, and we want the user to be able
' to enter semicolons rather than some other delimiter. So we
' simply require the user to enclose multiple commands inside
' curly braces.
'
' This function is simple and reliable, but a missing right
' curly brace can cause serious problems. Therefore we check
' that braces match elsewhere, in routine Interp.
'
R$ = ""
braces% = 0
For I& = 1 To Len(S$)
C$ = Mid$(S$, I&, 1)
Select Case C$
Case "{"
braces% = braces% + 1
Case "}"
If braces% > 0 Then braces% = braces% - 1
Case ";"
If braces% > 0 Then C$ = Chr$(0)
End Select
R$ = R$ & C$
Next
LoopHack = R$
End Function
Function Loopstring (ByVal CMD$) As String
'
' Given a string, extract from it the part between curly braces
' and return that part. This function is used to turn the second
' argument of a LOOP command into a commandstring ready for the
' Interp routine.
'
' This function is also used with the Tektronix SEND command to
' send multiple commands to the oscilloscope.
'
length& = InStr(CMD$, "}") - InStr(CMD$, "{") - 1
If InStr(CMD$, "{") < 1 Then
Loopstring = ""
ElseIf length& > 0 Then
T$ = Mid$(CMD$, InStr(CMD$, "{") + 1, length&)
Loopstring = T$
Else
Loopstring = ""
End If
End Function
Sub Main ()
'
' Main subroutine. Interfaces with WinHTTPD server via files.
' Processes client commands and passes them to RTI-815 and
' Tektronix 222 routines. Obtains data from Tektronix 222 and
' returns it to the client.
'
' First order of business: record startup in log file
Starttime$ = Time$
Startdatetime$ = Starttime$ & " " & Format$(Now, "m/d/yy")
Timestamp$ = "BEGIN Main " & Startdatetime$
Call AppendToFIle(RTILog$, Timestamp$ & CRLF())
''''''''''''''''
' DEBUG SECTION
' Exit Sub
''''''''''''''''
' initialize global variables
CommandNumber = 0
RecursionLevel = 0
WaveformCount = 0
gstrLogString = "BEGIN PROGRAM " & Startdatetime$ & CRLF()
' Session log file is named with an eight-digit number. First
' two digits are day of month, next six digits are hour, minute
' and seconds of start time.
T$ = Format$(Now, "dd") & StrSub(Starttime$, ":", "")
SessionLog = "SESSION\" & T$ & ".LOG"
' get command-line arguments
strCmdLine$ = Command$
strDataFile$ = Split(strCmdLine$, 1, " ") ' See WinHTTPD docs
strContentFile$ = Split(strCmdLine$, 2, " ") ' for explanation of
strOutputFile$ = Split(strCmdLine$, 3, " ") ' command-line args
strURLArgs$ = Split(strCmdLine$, 4, " ")
CGI_ProfileFile = strDataFile$
' If RTI board is locked, return contents of lockfile and pointer
' to unlock utility, otherwise create a lockfile and proceed.
If Dir$(Lockfile$) <> "" Then
UnlockFile$ = "http://piper.princeton.edu/cgi-win/unlock.exe"
URL$ = HTML_href(UnlockFile$, "Unlock WEBRTI")
B$ = HTML_H1("File lock: ") & HTML_pre(Filecontents(Lockfile$))
B$ = B$ & CRLF() & HTML_H2(URL$) & CRLF()
Doc$ = HTML_Document("WEBRTI locked", B$)
Call AppendToFIle(strOutputFile$, Doc$)
Exit Sub
Else
T$ = Format$(Now, "h:m:ss m/d/yy") & " "
T$ = T$ & GetProfile("CGI", "Remote Host") & " "
T$ = T$ & GetProfile("CGI", "Remote Address") & CRLF()
Call AppendToFIle(Lockfile$, T$)
End If
' Remove Tektronix session log from previous run of program.
' It is necessary to check if it exists first to prevent a
' run-time error.
If Dir$(RTIDir$ & TekLog$) <> "" Then
Kill RTIDir$ & TekLog$
End If
' initialize RTI board
gstrLogString = gstrLogString & "RTI Initialization: "
gstrLogString = gstrLogString & RTI_Initialize() & CRLF()
' initialize the COM port used with the oscilloscope
gstrLogString = gstrLogString & "COM Initialization: "
gstrLogString = gstrLogString & Tek_initialize() & CRLF()
' Look for value of "commandstring" in URL argument, then
' content-file
arg$ = GetURLValue("commandstring", strURLArgs$)
cont$ = GetURLValue("commandstring", Filecontents(strContentFile$))
strEncoded$ = IIf(arg$ <> "", arg$, cont$)
strDecoded$ = URLDecode(strEncoded$)
out$ = "encoded commandstring=" & strEncoded$ & CRLF()
Call AppendToFIle(RTILog$, out$)
out$ = "normalized commandstring=" & NormalizeCommand(strDecoded$)
out$ = out$ & CRLF()
Call AppendToFIle(RTILog$, out$)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ******************************************************** '
' * * '
' * This is the part where all of the important stuff * '
' * begins. If you want to understand how this code * '
' * works, begin tracing execution here, at Interp(). * '
' * * '
' ******************************************************** '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call Interp(strDecoded$)
' write to session log files
T$ = CRLF() & CRLF() & "END PROGRAM "
T$ = T$ & Format$(Now, "h:m:ss m/d/yy") & CRLF()
Call AppendToFIle(RTIDir$ & SessionLog, gstrLogString & T$)
Call ClobberFile(RTIDir$ & TekLog$, TekPointersFile())
' if the data body received contains a value "rf" ("returnfile"),
' then return the contents of that file, else return a file of
' pointers to session logs & scope dumps
T$ = URLDecode(GetURLValue("rf", strURLArgs$))
If T$ = "" Then
T$ = GetURLValue("rf", Filecontents(strContentFile$))
End If
RF$ = URLDecode(T$)
If RF$ <> "" Then
Call AppendToFIle(strOutputFile$, Filecontents(RTIDir$ & RF$))
Else
Call AppendToFIle(strOutputFile$, ReturnFile())
End If
Unload frmWEBRTIcontrols
' Unlock the WEBRTI program. We first check that it's there
' to avoid a run-time error which would otherwise occur if someone
' forcibly unlocked the system during execution of this process.
If Dir$(Lockfile$) <> "" Then Kill Lockfile$
' Last order of business: record termination in log file
T$ = "END Main " & Format$(Now, "h:m:ss m/d/yy") & CRLF() & CRLF()
Call AppendToFIle(RTILog$, T$)
End Sub
Function NormalizeCommand (ByVal CMD$) As String
'
' Given a command string (already decoded -- NOT URL-encoded),
' normalize it by replacing CRLF with semicolons, stripping
' comments. Note: this method is buggy because a semicolon
' WITHIN a comment causes mayhem.
'
' This should be re-written using my Strsub routine, in the
' UTILITY.BAS module.
'
R1$ = ""
' convert CRLF to semicolon, assuming that carriage returns and
' linefeeds always occur together (reasonable assumption on DOS
' system)
For I& = 1 To Len(CMD$)
C$ = Mid$(CMD$, I&, 1)
Select Case C$
Case Chr$(13) ' strip carriage returns
R1$ = R1$
Case Chr$(10) ' replace newline with semicolon
R1$ = R1$ & ";"
Case Else
R1$ = R1$ & C$
End Select
Next
' strip out comments, defined as anything from a "#" to a
' semicolon
R2$ = ""
For I& = 1 To Len(R1$)
C$ = Mid$(R1$, I&, 1)
If C$ = "#" Then
Do While C$ <> ";" And I& < Len(R1$)
I& = I& + 1
C$ = Mid$(R1$, I&, 1)
Loop
End If
R2$ = R2$ & C$
Next
NormalizeCommand = R2$
End Function
Function ReturnFile () As String
'
' Return a string consisting of an HTML file to be returned to
' the client. This HTML file contains pointers to various other
' files containing information of interest to the client-end
' user.
'
DQ$ = Chr$(34) ' Double-quote character
Title$ = "Feedback from WEBRTI.EXE"
C$ = CRLF()
SL$ = StrSub(SessionLog, "\", "/") ' must use forward slashes
' in hyperlinks
F$ = C$ & HTML_H1("Data files generated:") & C$ & C$
F$ = F$ & "<dl>" & C$
F$ = F$ & " <dt><a href=" & DQ$ & HREF$ & SL$ & DQ$
F$ = F$ & ">Session Log</a>" & C$
F$ = F$ & " <dd>A detailed record of every command executed by "
F$ = F$ & "the WEBRTI.EXE" & C$
F$ = F$ & " interpreter, including error messages resulting"
F$ = F$ & " from each command." & C$
F$ = F$ & " Values returned by input commands like DIN and "
F$ = F$ & "XAIN are recorded" & C$
F$ = F$ & " here too." & C$
F$ = F$ & " <dt><a href=" & DQ$ & HREF$ & TekLog$ & DQ$
F$ = F$ & ">Tektronix Dumps</a>" & C$
F$ = F$ & " <dd>Links to individual .WFM files containing "
F$ = F$ & "oscilloscope traces" & C$
F$ = F$ & " from the Tektronix 222." & C$
F$ = F$ & "</dl>" & C$ & C$
'
' Return a warning message if there are lots of .LOG files in
' the session directory. Each of these files can be arbitrarily
' large, so it's important that they be purged!
'
SD$ = RTIDir$ & "SESSION\"
pat$ = SD$ & "*.LOG"
NF& = NumFiles(pat$)
If NF& > 20 Then
F$ = F$ & "<hr>" & C$ & C$ & "<p>" & C$
F$ = F$ & "<strong>NOTE:</strong> Session directory" & C$
F$ = F$ & SD$ & C$ & " contains " & Trim$(Str$(NF&))
F$ = F$ & " .LOG files. Delete if no longer needed!" & C$
F$ = F$ & "After you have viewed the current log you can" & C$
T$ = "click here to purge session log directory."
F$ = F$ & HTML_href(Purge$, T$)
F$ = F$ & C$ & "</p>" & C$ & C$
End If
ReturnFile = HTML_Document(Title$, F$)
End Function
Function TekPointersFile () As String
'
' Return an HTML file containing pointers to HTML files generated by
' the Tek_get routine.
'
Title$ = "Pointers to Oscilloscope Waveforms"
Body$ = HTML_H1(Trim$(Str$(WaveformCount)) & " traces generated:")
If WaveformCount > 0 Then
Body$ = Body$ & CRLF() & "<ol>" & CRLF()
For I% = 1 To WaveformCount
Filename$ = "TEK_" & Format$(I%, "0000") & ".WFM"
link$ = HTML_href(HREF$ & Filename$, Filename$)
Body$ = Body$ & "<li>" & link$ & CRLF()
Next
Body$ = Body$ & "</ol>"
Else
Body$ = HTML_H1("No waveforms generated")
End If
' yet another hack: strip out the MIME header that function
' HTML_Document inserts into its output
Bad$ = "Content-type: text/html" & CRLF() & CRLF()
T$ = StrSub(HTML_Document(Title$, Body$), Bad$, "")
TekPointersFile = T$
End Function