1# httpTest.tcl 2# 3# Test HTTP/1.1 concurrent requests including 4# queueing, pipelining and retries. 5# 6# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net> 7# 8# See the file "license.terms" for information on usage and redistribution 9# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 11# ------------------------------------------------------------------------------ 12# "Package" httpTest for analysis of Log output of http requests. 13# ------------------------------------------------------------------------------ 14# This is a specialised test kit for examining the presence, ordering, and 15# overlap of multiple HTTP transactions over a persistent ("Keep-Alive") 16# connection; and also for testing reconnection in accordance with RFC 7230 when 17# the connection is lost. 18# 19# This kit is probably not useful for other purposes. It depends on the 20# presence of specific Log commands in the http library, and it interprets the 21# logs that these commands create. 22# ------------------------------------------------------------------------------ 23 24package require http 25 26namespace eval ::http { 27 variable TestStartTimeInMs [clock milliseconds] 28# catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"} 29} 30 31namespace eval ::httpTest { 32 variable testResults {} 33 variable testOptions 34 array set testOptions { 35 -verbose 0 36 -dotted 1 37 } 38 # -verbose - 0 quiet 1 write to stdout 2 write more 39 # -dotted - (boolean) use dots for absences in lists of transactions 40} 41 42proc httpTest::Puts {txt} { 43 variable testOptions 44 if {$testOptions(-verbose) > 0} { 45 puts stdout $txt 46 flush stdout 47 } 48 return 49} 50 51# http::Log 52# 53# A special-purpose logger used for running tests. 54# - Processes Log calls that have "^" in their arguments, and records them in 55# variable ::httpTest::testResults. 56# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0). 57# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1). 58 59proc http::Log {args} { 60 variable TestStartTimeInMs 61 set time [expr {[clock milliseconds] - $TestStartTimeInMs}] 62 set txt [list $time {*}$args] 63 if {[string first ^ $txt] >= 0} { 64 ::httpTest::LogRecord $txt 65 ::httpTest::Puts $txt 66 } elseif {$::httpTest::testOptions(-verbose) > 1} { 67 ::httpTest::Puts $txt 68 } 69 return 70} 71# The http::Log routine above needs the variable ::httpTest::testOptions 72# Set up to destroy it when that variable goes away. 73trace add variable ::httpTest::testOptions unset {apply {args { 74 proc ::http::Log args {} 75}}} 76 77# Called by http::Log (the "testing" version) to record logs for later analysis. 78 79proc httpTest::LogRecord {txt} { 80 variable testResults 81 82 set pos [string first ^ $txt] 83 set len [string length $txt] 84 if {$pos > $len - 3} { 85 puts stdout "Logging Error: $txt" 86 puts stdout "Fix this call to Log in http-*.tm so it has ^ then\ 87 a letter then a numeral." 88 flush stdout 89 } elseif {$pos < 0} { 90 # Called by mistake. 91 } else { 92 set letter [string index $txt [incr pos]] 93 set number [string index $txt [incr pos]] 94 # Max 9 requests! 95 lappend testResults [list $letter $number] 96 } 97 98 return 99} 100 101 102# ------------------------------------------------------------------------------ 103# Commands for analysing the logs recorded when calling http::geturl. 104# ------------------------------------------------------------------------------ 105 106# httpTest::TestOverlaps -- 107# 108# The main test for correct behaviour of pipelined and sequential 109# (non-pipelined) transactions. Other tests should be run first to detect 110# any inconsistencies in the data (e.g. absence of the elements that are 111# examined here). 112# 113# Examine the sequence $someResults for each transaction from 1 to $n, 114# ignoring any that are listed in $badTrans. 115# Determine whether the elements "B" to $term for one transaction overlap 116# elements "B" to $term for the previous and following transactions. 117# 118# Transactions in the list $badTrans are not included in "clean" or 119# "dirty", but their possible overlap with other transactions is noted. 120# Transactions in the list $notPiped are a subset of $badTrans, and 121# their possible overlap with other transactions is NOT noted. 122# 123# Arguments: 124# someResults - list of results, each of the form {letter numeral} 125# n - number of HTTP transactions 126# term - letter that indicated end of search range. "E" for testing 127# overlaps from start of request to end of response headers. 128# "F" to extend to the end of the response body. 129# msg - the cumulative message from sanity checks. Append to it only 130# to report a test failure. 131# badTrans - list of transaction numbers not to be assessed as "clean" or 132# "dirty" 133# notPiped - subset of badTrans. List of transaction numbers that cannot 134# taint another transaction by overlapping with it, because it 135# used a different socket. 136# 137# Return value: [list $msg $clean $dirty] 138# msg - warning messages: nothing will be appended to argument $msg if there 139# is an error with the test. 140# clean - list of transactions that have no overlap with other transactions 141# dirty - list of transactions that have YES overlap with other transactions 142 143proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} { 144 variable testOptions 145 146 # Check whether transactions overlap: 147 set clean {} 148 set dirty {} 149 for {set i 1} {$i <= $n} {incr i} { 150 if {$i in $badTrans} { 151 continue 152 } 153 set myStart [lsearch -exact $someResults [list B $i]] 154 set myEnd [lsearch -exact $someResults [list $term $i]] 155 156 if {($myStart < 0 || $myEnd < 0)} { 157 set res "Cannot find positions of transaction $i" 158 append msg $res \n 159 Puts $res 160 } 161 162 set overlaps {} 163 for {set j $myStart} {$j <= $myEnd} {incr j} { 164 lassign [lindex $someResults $j] letter number 165 if {$number != $i && $letter ne "A" && $number ni $notPiped} { 166 lappend overlaps $number 167 } 168 } 169 170 if {[llength $overlaps] == 0} { 171 set res "Transaction $i has no overlaps" 172 Puts $res 173 lappend clean $i 174 if {$testOptions(-dotted)} { 175 # N.B. results from different segments are concatenated. 176 lappend dirty . 177 } else { 178 } 179 } else { 180 set res "Transaction $i overlaps with [join $overlaps { }]" 181 Puts $res 182 lappend dirty $i 183 if {$testOptions(-dotted)} { 184 # N.B. results from different segments are concatenated. 185 lappend clean . 186 } else { 187 } 188 } 189 } 190 return [list $msg $clean $dirty] 191} 192 193# httpTest::PipelineNext -- 194# 195# Test whether prevPair, pair are valid as consecutive elements of a pipelined 196# sequence (Start 1), (End 1), (Start 2), (End 2) ... 197# Numbers are integers increasing (by 1 if argument "any" is false), and need 198# not begin with 1. 199# The first element of the sequence has prevPair {} and is always passed as 200# valid. 201# 202# Arguments; 203# Start - string that labels the start of a segment 204# End - string that labels the end of a segment 205# prevPair - previous "pair" (list of string and number) element of a 206# sequence, or {} if argument "pair" is the first in the 207# sequence. 208# pair - current "pair" (list of string and number) element of a 209# sequence 210# any - (boolean) iff true, accept any increasing sequence of integers. 211# If false, integers must increase by 1. 212# 213# Return value - boolean, true iff the two pairs are valid consecutive elements. 214 215proc httpTest::PipelineNext {Start End prevPair pair any} { 216 if {$prevPair eq {}} { 217 return 1 218 } 219 220 lassign $prevPair letter number 221 lassign $pair newLetter newNumber 222 if {$letter eq $Start} { 223 return [expr {($newLetter eq $End) && ($newNumber == $number)}] 224 } elseif {$any} { 225 set nxt [list $Start [expr {$number + 1}]] 226 return [expr {($newLetter eq $Start) && ($newNumber > $number)}] 227 } else { 228 set nxt [list $Start [expr {$number + 1}]] 229 return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}] 230 } 231} 232 233# httpTest::TestPipeline -- 234# 235# Given a sequence of "pair" elements, check that the elements whose string is 236# $Start or $End form a valid pipeline. Ignore other elements. 237# 238# Return value: {} if valid pipeline, otherwise a non-empty error message. 239 240proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} { 241 set sequence {} 242 set prevPair {} 243 set ok 1 244 set any [llength $badTrans] 245 foreach pair $someResults { 246 lassign $pair letter number 247 if {($letter in [list $Start $End]) && ($number ni $badTrans)} { 248 lappend sequence $pair 249 if {![PipelineNext $Start $End $prevPair $pair $any]} { 250 set ok 0 251 break 252 } 253 set prevPair $pair 254 } 255 } 256 257 if {!$ok} { 258 set res "$desc are not pipelined: {$sequence}" 259 append msg $res \n 260 Puts $res 261 } 262 return $msg 263} 264 265# httpTest::TestSequence -- 266# 267# Examine each transaction from 1 to $n, ignoring any that are listed 268# in $badTrans. 269# Check that each transaction has elements A to F, in alphabetical order. 270 271proc httpTest::TestSequence {someResults n msg badTrans} { 272 variable testOptions 273 274 for {set i 1} {$i <= $n} {incr i} { 275 if {$i in $badTrans} { 276 continue 277 } 278 set sequence {} 279 foreach pair $someResults { 280 lassign $pair letter number 281 if {$number == $i} { 282 lappend sequence $letter 283 } 284 } 285 if {$sequence eq {A B C D E F}} { 286 } else { 287 set res "Wrong sequence for token ::http::$i - {$sequence}" 288 append msg $res \n 289 Puts $res 290 if {"X" in $sequence} { 291 set res "- and error(s) X" 292 append msg $res \n 293 Puts $res 294 } 295 if {"Y" in $sequence} { 296 set res "- and warnings(s) Y" 297 append msg $res \n 298 Puts $res 299 } 300 } 301 } 302 return $msg 303} 304 305# 306# Arguments: 307# someResults - list of elements, each a list of a letter and a number 308# n - (positive integer) the number of HTTP requests 309# msg - accumulated warning messages 310# skipOverlaps - (boolean) whether to skip testing of transaction overlaps 311# badTrans - list of transaction numbers not to be assessed as "clean" or 312# "dirty" by their overlaps 313# for 1/2 includes all transactions 314# for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled. 315# notPiped - subset of badTrans. List of transaction numbers that cannot 316# taint another transaction by overlapping with it, because it 317# used a different socket. 318# 319# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF] 320# msg - warning messages: nothing will be appended to argument $msg if there 321# is no error with the test. 322# cleanE - list of transactions that have no overlap with other transactions 323# (not considering response body) 324# dirtyE - list of transactions that have YES overlap with other transactions 325# (not considering response body) 326# cleanF - list of transactions that have no overlap with other transactions 327# (including response body) 328# dirtyF - list of transactions that have YES overlap with other transactions 329# (including response body) 330 331proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} { 332 variable testOptions 333 334 # Check that stages for "good" transactions are all present and correct: 335 set msg [TestSequence $someResults $n $msg $badTrans] 336 337 # Check that requests are pipelined: 338 set msg [TestPipeline $someResults $n B C $msg Requests $notPiped] 339 340 # Check that responses are pipelined: 341 set msg [TestPipeline $someResults $n D F $msg Responses $notPiped] 342 343 if {$skipOverlaps} { 344 set cleanE {} 345 set dirtyE {} 346 set cleanF {} 347 set dirtyF {} 348 } else { 349 Puts "Overlaps including response body (test for non-pipelined case)" 350 lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF 351 352 Puts "Overlaps without response body (test for pipelined case)" 353 lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE 354 } 355 356 return [list $msg $cleanE $cleanF $dirtyE $dirtyF] 357} 358 359# httpTest::ProcessRetries -- 360# 361# Command to examine results for socket-changing records [PQR], 362# divide the results into segments for each connection, and analyse each segment 363# individually. 364# (Could add $sock to the logging to simplify this, but never mind.) 365# 366# In each segment, identify any transactions that are not included, and 367# any that are aborted, to assist subsequent testing. 368# 369# Prepend A records (socket-independent) to each segment for transactions that 370# were scheduled (by A) but not completed (by F). Pass each segment to 371# MostAnalysis for processing. 372 373proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} { 374 variable testOptions 375 376 set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}] 377 if {$nextRetry < 0} { 378 return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped] 379 } 380 set badTrans $notIncluded 381 set tryCount 0 382 set try $nextRetry 383 incr tryCount 384 lassign [lindex $someResults $try] letter number 385 Puts "Processing retry [lindex $someResults $try]" 386 set beforeTry [lrange $someResults 0 $try-1] 387 Puts [join $beforeTry \n] 388 set afterTry [lrange $someResults $try+1 end] 389 390 set dummyTry {} 391 for {set i 1} {$i <= $n} {incr i} { 392 set first [lsearch -exact $beforeTry [list A $i]] 393 set last [lsearch -exact $beforeTry [list F $i]] 394 if {$first < 0} { 395 set res "Transaction $i was not started in connection number $tryCount" 396 # So lappend it to badTrans and don't include it in the call below of MostAnalysis. 397 # append msg $res \n 398 Puts $res 399 if {$i ni $badTrans} { 400 lappend badTrans $i 401 } else { 402 } 403 } elseif {$last < 0} { 404 set res "Transaction $i was started but unfinished in connection number $tryCount" 405 # So lappend it to badTrans and don't include it in the call below of MostAnalysis. 406 # append msg $res \n 407 Puts $res 408 lappend badTrans $i 409 lappend dummyTry [list A $i] 410 } else { 411 set res "Transaction $i was started and finished in connection number $tryCount" 412 # So include it in the call below of MostAnalysis. 413 # So lappend it to notIncluded and don't include it in the recursive call of 414 # ProcessRetries which handles the later connections. 415 # append msg $res \n 416 Puts $res 417 lappend notIncluded $i 418 } 419 } 420 421 # Analyse the part of the results before the first replay: 422 set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped] 423 lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1 424 425 # Pass the rest of the results to be processed recursively. 426 set afterTry [concat $dummyTry $afterTry] 427 set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped] 428 lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2 429 430 set cleanE [concat $cleanE1 $cleanE2] 431 set cleanF [concat $cleanF1 $cleanF2] 432 set dirtyE [concat $dirtyE1 $dirtyE2] 433 set dirtyF [concat $dirtyF1 $dirtyF2] 434 return [list $msg $cleanE $cleanF $dirtyE $dirtyF] 435} 436 437# httpTest::logAnalyse -- 438# 439# The main command called to analyse logs for a single test. 440# 441# Arguments: 442# n - (positive integer) the number of HTTP requests 443# skipOverlaps - (boolean) whether to skip testing of transaction overlaps 444# notIncluded - list of transaction numbers not to be assessed as "clean" or 445# "dirty" by their overlaps 446# notPiped - subset of notIncluded. List of transaction numbers that cannot 447# taint another transaction by overlapping with it, because it 448# used a different socket. 449# 450# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF] 451# msg - warning messages: {} if there is no error with the test. 452# cleanE - list of transactions that have no overlap with other transactions 453# (not considering response body) 454# dirtyE - list of transactions that have YES overlap with other transactions 455# (not considering response body) 456# cleanF - list of transactions that have no overlap with other transactions 457# (including response body) 458# dirtyF - list of transactions that have YES overlap with other transactions 459# (including response body) 460 461proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} { 462 variable testResults 463 variable testOptions 464 465 # Check that each data item has the correct form {letter numeral}. 466 set ii 0 467 set ok 1 468 foreach pair $testResults { 469 lassign $pair letter number 470 if { [string match {[A-Z]} $letter] 471 && [string match {[0-9]} $number] 472 } { 473 # OK 474 } else { 475 set ok 0 476 set res "Error: testResults has bad element {$pair} at position $ii" 477 append msg $res \n 478 Puts $res 479 } 480 incr ii 481 } 482 483 if {!$ok} { 484 return $msg 485 } 486 set msg {} 487 488 Puts [join $testResults \n] 489 ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped 490 # N.B. Implicit Return. 491} 492 493proc httpTest::cleanupHttpTest {} { 494 variable testResults 495 set testResults {} 496 return 497} 498 499proc httpTest::setHttpTestOptions {key args} { 500 variable testOptions 501 if {$key ni {-dotted -verbose}} { 502 return -code error {valid options are -dotted, -verbose} 503 } 504 set testOptions($key) {*}$args 505} 506 507namespace eval httpTest { 508 namespace export cleanupHttpTest logAnalyse setHttpTestOptions 509} 510