#####################################################################
# Name: httpQuery
# Purpose: Basic Message-driven HTTP query
# UPoC type: tps
# Args: tps keyedlist containing these keys:
# MODE run mode ("start", "run" or "test")
# MSGID message handle
# ARGS user-supplied arguments:
#####################################################################
proc httpQuery { args } {
global cfgs
keylget args MODE mode
set dispList {}
switch -exact -- $mode {
start
{
echo "I AM IN HTTPQUERY START\r"
# grab and store CFGS values for run mode --
# CFGS are only available in start mode.
keylget args CFGS cfgs
}
run
{
echo "I AM IN HTTPQUERY RUN\r"
# fetch and process msgid
keylget args MSGID inMsg
# fetch the URL using the specified method
keylget cfgs METHOD method
switch -exact -- $method {
PUT {
echo "HTTPPUT\r"
set res [httpput $cfgs]
}
POST {
echo "HTTPPOST\r"
set res [httppost $cfgs]
}
default {
echo "DEFAULT (GET) \r"
set res [httpget $cfgs]
}
}
# parse out the response
set status [keylget res "STATUS"]
set statCode [lindex $status 1]
set body [keylget res "BODY"]
if {$statCode == 200} {
# if OK, place msg into IB queue
set outMsg [msgcreate -type data $body]
lappend dispList "KILL $inMsg"
lappend dispList "OVER $outMsg"
} else {
# otherwise, report the error and send orig msg to error DB
echo "ERROR: Failed to fetch resource '$url'.\r"
echo "Fetch returned:\r$status\r"
error $inMsg
}
}
time
{
echo "I AM IN HTTPQUERY TIME\r"
# Timer-based processing
}
default {
}
}
return $dispList
}
######################################################################
# Name: httpFilesetFetch
# Purpose: Fileset-style directory contents fetch for HTTP
# UPoC type: tps
# Args: tps keyedlist containing these keys:
# MODE run mode ("start", "run" or "test")
# MSGID message handle
# ARGS user-supplied arguments:
#
######################################################################
proc httpFilesetFetch { args } {
global srcDir
global cfgs
keylget args MODE mode
keylget args CFGS cfgs
keylget args ARGS userargs
keylget userargs FOO foo
set dispList {}
switch -exact -- $mode {
start
{
# Perform special init functions
echo "I AM IN FILESETFETCH START\r"
# grab and store CFGS values for run mode --
# CFGS are only available in start mode.
}
run
{
# Not used...
# httpFilesetFetch is timer-based, NOT message-driven.
echo "I AM IN FILESETFETCH RUN\r"
}
time
{
echo "I AM IN FILESETFETCH TIME\r"
# Get a list of fetchable URLs contained in the directory
set urlList [httpDirParse $cfgs]
# Fetch each URL in the list
foreach url $urlList {
set new [list "URL" $url]
set res [httpget [linsert $cfgs 0 $new ]]
set status [keylget res "STATUS"]
set statCode [lindex $status 1]
set body [keylget res "BODY"]
if {$statCode == 200} {
lappend dispList "OVER [msgcreate -type data $body]"
} else {
error "ERROR: Failed to fetch resource '$url'.\rFetch returned:\r$status\r"
}
}
}
default {
}
}
return $dispList
}
##############################################################
# Function for parsing a standard Apache-style web-server-
# generated HTML directory listing. The function takes
# the same arguments as the httpget function, passing them
# as-is to httpget. It fetches the HTML directory index
# at the specified URL and returns a list of URLs that can
# then be fetched individually.
#################################################################
proc httpDirParse { args } {
set arg0 [lindex $args 0]
keylget arg0 URL url
set resp [httpget $arg0 ]
set dir1 [keylget resp "BODY"]
set dir1 [string toupper $dir1]
set p1 [string first "<A HREF" $dir1]
while {$p1 >= 0} {
set dir1 [string range $dir1 $p1 end]
set p2 [string first "/A>" $dir1]
set href [string range $dir1 0 $p2]
set dir1 [string range $dir1 $p2 end]
set q1 [string first "\"" $href]
set q2 [string last "\"" $href]
set ref [string range $href $q1 $q2]
set ref [string trim $ref "\""]
if { [regexp {^[A-Z]} $ref] == 1} {
set eref $url
append eref [string tolower $ref]
lappend urls $eref
}
set p1 [string first "<A HREF" $dir1]
}
return $urls
}