Artifact
4f2bfa076db6dde808b6155b65a6f1016aac0391:
- File
test/many-www.tcl
— part of check-in
[76e8600b94]
at
2012-11-08 20:51:35
on branch trunk
— Correctly escape ZIP and Tarball filenames for URLs. Limit SHA1 hashs on
diff URLs using %S instead of %s. Limit the number of links to follow off
of each page in the many-www.tcl test script.
(user:
drh
size: 1847)
[more...]
0000: 23 21 2f 75 73 72 2f 62 69 6e 2f 74 63 6c 73 68 #!/usr/bin/tclsh
0010: 0a 23 0a 23 20 52 75 6e 20 74 68 69 73 20 73 63 .#.# Run this sc
0020: 72 69 70 74 20 66 72 6f 6d 20 77 69 74 68 69 6e ript from within
0030: 20 61 6e 79 20 6f 70 65 6e 20 46 6f 73 73 69 6c any open Fossil
0040: 20 63 68 65 63 6b 6f 75 74 2e 20 20 45 78 61 6d checkout. Exam
0050: 70 6c 65 3a 0a 23 0a 23 20 20 20 74 63 6c 73 68 ple:.#.# tclsh
0060: 20 6d 61 6e 79 2d 77 77 77 2e 74 63 6c 20 7c 20 many-www.tcl |
0070: 74 65 65 20 6f 75 74 2e 74 78 74 0a 23 0a 23 20 tee out.txt.#.#
0080: 41 62 6f 75 74 20 31 30 2c 30 30 30 20 64 69 66 About 10,000 dif
0090: 66 65 72 65 6e 74 20 77 65 62 20 70 61 67 65 20 ferent web page
00a0: 72 65 71 75 65 73 74 73 20 77 69 6c 6c 20 62 65 requests will be
00b0: 20 6d 61 64 65 2e 20 20 45 61 63 68 20 69 73 20 made. Each is
00c0: 74 69 6d 65 64 0a 23 20 61 6e 64 20 74 68 65 20 timed.# and the
00d0: 74 69 6d 65 20 73 68 6f 77 6e 20 6f 6e 20 6f 75 time shown on ou
00e0: 74 70 75 74 2e 20 55 73 65 20 74 68 69 73 20 73 tput. Use this s
00f0: 63 72 69 70 74 20 74 6f 20 73 65 61 72 63 68 20 cript to search
0100: 66 6f 72 20 73 65 67 66 61 75 6c 74 20 70 72 6f for segfault pro
0110: 62 6c 65 6d 73 0a 23 20 6f 72 20 74 6f 20 6c 6f blems.# or to lo
0120: 6f 6b 20 66 6f 72 20 70 61 67 65 73 20 74 68 61 ok for pages tha
0130: 74 20 6e 65 65 64 20 6f 70 74 69 6d 69 7a 61 74 t need optimizat
0140: 69 6f 6e 2e 0a 23 0a 70 72 6f 63 20 72 75 6e 5f ion..#.proc run_
0150: 71 75 65 72 79 20 7b 75 72 6c 7d 20 7b 0a 20 20 query {url} {.
0160: 73 65 74 20 66 64 20 5b 6f 70 65 6e 20 71 2e 74 set fd [open q.t
0170: 78 74 20 77 5d 0a 20 20 70 75 74 73 20 24 66 64 xt w]. puts $fd
0180: 20 22 47 45 54 20 24 75 72 6c 20 48 54 54 50 2f "GET $url HTTP/
0190: 31 2e 30 5c 72 5c 6e 5c 72 22 0a 20 20 63 6c 6f 1.0\r\n\r". clo
01a0: 73 65 20 24 66 64 0a 20 20 72 65 74 75 72 6e 20 se $fd. return
01b0: 5b 65 78 65 63 20 66 6f 73 73 69 6c 20 74 65 73 [exec fossil tes
01c0: 74 2d 68 74 74 70 20 3c 71 2e 74 78 74 5d 0a 7d t-http <q.txt].}
01d0: 0a 73 65 74 20 74 6f 64 6f 20 7b 7d 0a 66 6f 72 .set todo {}.for
01e0: 65 61 63 68 20 75 72 6c 20 7b 0a 20 20 2f 68 6f each url {. /ho
01f0: 6d 65 0a 20 20 2f 74 69 6d 65 6c 69 6e 65 0a 20 me. /timeline.
0200: 20 2f 62 72 6c 69 73 74 0a 20 20 2f 74 61 67 6c /brlist. /tagl
0210: 69 73 74 0a 20 20 2f 72 65 70 6f 72 74 6c 69 73 ist. /reportlis
0220: 74 0a 20 20 2f 73 65 74 75 70 0a 20 20 2f 64 69 t. /setup. /di
0230: 72 0a 20 20 2f 77 63 6f 6e 74 65 6e 74 0a 20 20 r. /wcontent.
0240: 2f 61 74 74 61 63 68 6c 69 73 74 0a 20 20 2f 74 /attachlist. /t
0250: 61 67 6c 69 73 74 0a 20 20 2f 74 65 73 74 5f 65 aglist. /test_e
0260: 6e 76 0a 20 20 2f 73 74 61 74 0a 20 20 2f 72 63 nv. /stat. /rc
0270: 76 66 72 6f 6d 6c 69 73 74 0a 20 20 2f 75 72 6c vfromlist. /url
0280: 6c 69 73 74 0a 20 20 2f 6d 6f 64 72 65 71 0a 20 list. /modreq.
0290: 20 2f 69 6e 66 6f 2f 64 35 63 34 0a 20 20 2f 74 /info/d5c4. /t
02a0: 65 73 74 2d 61 6c 6c 2d 68 65 6c 70 0a 20 20 2f est-all-help. /
02b0: 6c 65 61 76 65 73 0a 20 20 2f 74 69 6d 65 6c 69 leaves. /timeli
02c0: 6e 65 3f 61 3d 31 39 37 30 2d 30 31 2d 30 31 0a ne?a=1970-01-01.
02d0: 7d 20 7b 0a 20 20 73 65 74 20 73 65 65 6e 28 24 } {. set seen($
02e0: 75 72 6c 29 20 31 0a 20 20 73 65 74 20 70 65 6e url) 1. set pen
02f0: 64 69 6e 67 28 24 75 72 6c 29 20 31 0a 7d 0a 73 ding($url) 1.}.s
0300: 65 74 20 72 6f 75 6e 64 20 31 0a 73 65 74 20 6c et round 1.set l
0310: 69 6d 69 74 20 32 35 30 30 30 0a 73 65 74 20 6e imit 25000.set n
0320: 70 65 6e 64 69 6e 67 20 5b 6c 6c 65 6e 67 74 68 pending [llength
0330: 20 5b 61 72 72 61 79 20 6e 61 6d 65 73 20 70 65 [array names pe
0340: 6e 64 69 6e 67 5d 5d 0a 70 72 6f 63 20 67 65 74 nding]].proc get
0350: 5f 70 65 6e 64 69 6e 67 20 7b 7d 20 7b 0a 20 20 _pending {} {.
0360: 67 6c 6f 62 61 6c 20 70 65 6e 64 69 6e 67 20 6e global pending n
0370: 70 65 6e 64 69 6e 67 20 72 6f 75 6e 64 20 6e 65 pending round ne
0380: 78 74 0a 20 20 69 66 20 7b 24 6e 70 65 6e 64 69 xt. if {$npendi
0390: 6e 67 3d 3d 30 7d 20 7b 0a 20 20 20 20 69 6e 63 ng==0} {. inc
03a0: 72 20 72 6f 75 6e 64 0a 20 20 20 20 61 72 72 61 r round. arra
03b0: 79 20 73 65 74 20 70 65 6e 64 69 6e 67 20 5b 61 y set pending [a
03c0: 72 72 61 79 20 67 65 74 20 6e 65 78 74 5d 0a 20 rray get next].
03d0: 20 20 20 73 65 74 20 6e 70 65 6e 64 69 6e 67 20 set npending
03e0: 5b 6c 6c 65 6e 67 74 68 20 5b 61 72 72 61 79 20 [llength [array
03f0: 6e 61 6d 65 73 20 70 65 6e 64 69 6e 67 5d 5d 0a names pending]].
0400: 20 20 20 20 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d unset -nocom
0410: 70 6c 61 69 6e 20 6e 65 78 74 0a 20 20 7d 0a 20 plain next. }.
0420: 20 73 65 74 20 72 65 73 20 5b 6c 69 6e 64 65 78 set res [lindex
0430: 20 5b 61 72 72 61 79 20 6e 61 6d 65 73 20 70 65 [array names pe
0440: 6e 64 69 6e 67 5d 20 5b 65 78 70 72 20 7b 69 6e nding] [expr {in
0450: 74 28 72 61 6e 64 28 29 2a 24 6e 70 65 6e 64 69 t(rand()*$npendi
0460: 6e 67 29 7d 5d 5d 0a 20 20 75 6e 73 65 74 20 70 ng)}]]. unset p
0470: 65 6e 64 69 6e 67 28 24 72 65 73 29 0a 20 20 69 ending($res). i
0480: 6e 63 72 20 6e 70 65 6e 64 69 6e 67 20 2d 31 0a ncr npending -1.
0490: 20 20 72 65 74 75 72 6e 20 24 72 65 73 0a 7d 0a return $res.}.
04a0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
04b0: 69 3c 24 6c 69 6d 69 74 7d 20 7b 69 6e 63 72 20 i<$limit} {incr
04c0: 69 7d 20 7b 0a 20 20 73 65 74 20 75 72 6c 20 5b i} {. set url [
04d0: 67 65 74 5f 70 65 6e 64 69 6e 67 5d 0a 20 20 70 get_pending]. p
04e0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 uts -nonewline "
04f0: 28 24 72 6f 75 6e 64 2f 5b 65 78 70 72 20 7b 24 ($round/[expr {$
0500: 69 2b 31 7d 5d 29 20 24 75 72 6c 20 22 0a 20 20 i+1}]) $url ".
0510: 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 20 20 73 flush stdout. s
0520: 65 74 20 74 6d 20 5b 74 69 6d 65 20 7b 73 65 74 et tm [time {set
0530: 20 78 20 5b 72 75 6e 5f 71 75 65 72 79 20 24 75 x [run_query $u
0540: 72 6c 5d 7d 5d 0a 20 20 73 65 74 20 6d 73 20 5b rl]}]. set ms [
0550: 6c 69 6e 64 65 78 20 24 74 6d 20 30 5d 0a 20 20 lindex $tm 0].
0560: 70 75 74 73 20 5b 66 6f 72 6d 61 74 20 7b 25 2e puts [format {%.
0570: 33 66 73 7d 20 5b 65 78 70 72 20 7b 24 6d 73 2f 3fs} [expr {$ms/
0580: 31 30 30 30 30 30 30 2e 30 7d 5d 5d 0a 20 20 66 1000000.0}]]. f
0590: 6c 75 73 68 20 73 74 64 6f 75 74 0a 20 20 69 66 lush stdout. if
05a0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
05b0: 20 24 78 5d 3e 31 30 30 30 30 30 30 7d 20 7b 0a $x]>1000000} {.
05c0: 20 20 20 20 73 65 74 20 78 20 5b 73 74 72 69 6e set x [strin
05d0: 67 20 72 61 6e 67 65 20 24 78 20 30 20 31 30 30 g range $x 0 100
05e0: 30 30 30 30 5d 0a 20 20 7d 0a 20 20 73 65 74 20 0000]. }. set
05f0: 6b 20 30 0a 20 20 77 68 69 6c 65 20 7b 5b 72 65 k 0. while {[re
0600: 67 65 78 70 20 7b 3c 5b 61 41 5d 20 2e 2a 3f 68 gexp {<[aA] .*?h
0610: 72 65 66 3d 22 28 2f 5b 61 2d 7a 5d 2e 2a 3f 29 ref="(/[a-z].*?)
0620: 22 2e 2a 3f 3e 28 2e 2a 29 24 7d 20 24 78 20 61 ".*?>(.*)$} $x a
0630: 6c 6c 20 75 72 6c 20 74 61 69 6c 5d 7d 20 7b 0a ll url tail]} {.
0640: 20 20 20 20 23 20 69 66 20 7b 24 6e 70 65 6e 64 # if {$npend
0650: 69 6e 67 3e 32 2a 28 24 6c 69 6d 69 74 20 2d 20 ing>2*($limit -
0660: 24 69 29 7d 20 62 72 65 61 6b 0a 20 20 20 20 69 $i)} break. i
0670: 6e 63 72 20 6b 0a 20 20 20 20 69 66 20 7b 24 6b ncr k. if {$k
0680: 3e 31 30 30 7d 20 62 72 65 61 6b 0a 20 20 20 20 >100} break.
0690: 73 65 74 20 75 32 20 5b 73 74 72 69 6e 67 20 6d set u2 [string m
06a0: 61 70 20 7b 26 6c 74 3b 20 3c 20 26 67 74 3b 20 ap {< < >
06b0: 3e 20 26 71 75 6f 74 3b 20 5c 22 20 26 61 6d 70 > " \" &
06c0: 3b 20 26 7d 20 24 75 72 6c 5d 0a 20 20 20 20 69 ; &} $url]. i
06d0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
06e0: 20 73 65 65 6e 28 24 75 32 29 5d 7d 20 7b 0a 20 seen($u2)]} {.
06f0: 20 20 20 20 20 73 65 74 20 6e 65 78 74 28 24 75 set next($u
0700: 32 29 20 31 0a 20 20 20 20 20 20 73 65 74 20 73 2) 1. set s
0710: 65 65 6e 28 24 75 32 29 20 31 0a 20 20 20 20 7d een($u2) 1. }
0720: 0a 20 20 20 20 73 65 74 20 78 20 24 74 61 69 6c . set x $tail
0730: 0a 20 20 7d 0a 7d 0a . }.}.