Artifact
b6b7bfed86ce759fab58e55342dd66cdfcec50f704013a63abcb2714ab37a37c:
0000: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0010: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0020: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0030: 23 0a 23 0a 23 20 45 78 61 6d 70 6c 65 20 31 3a #.#.# Example 1:
0040: 20 42 6c 6f 63 6b 69 6e 67 20 63 68 61 6e 6e 65 Blocking channe
0050: 6c 20 67 65 74 73 20 77 69 74 68 20 6e 6f 20 76 l gets with no v
0060: 61 72 69 61 62 6c 65 0a 23 0a 23 23 23 23 23 23 ariable.#.######
0070: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0080: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0090: 23 23 23 23 23 23 23 23 23 23 23 0a 0a 70 61 63 ###########..pac
00a0: 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 65 kage prefer late
00b0: 73 74 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 st.package requi
00c0: 72 65 20 54 63 6c 20 38 2e 36 2d 0a 70 61 63 6b re Tcl 8.6-.pack
00d0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
00e0: 0a 73 65 74 20 68 6f 73 74 20 22 77 77 77 2e 67 .set host "www.g
00f0: 6f 6f 67 6c 65 2e 63 6f 6d 22 0a 73 65 74 20 70 oogle.com".set p
0100: 6f 72 74 20 34 34 33 0a 73 65 74 20 70 61 74 68 ort 443.set path
0110: 20 22 2f 22 0a 73 65 74 20 70 72 6f 74 6f 63 6f "/".set protoco
0120: 6c 20 22 68 74 74 70 2f 31 2e 31 22 0a 0a 23 0a l "http/1.1"..#.
0130: 23 20 53 65 6e 64 20 48 54 54 50 20 47 65 74 20 # Send HTTP Get
0140: 52 65 71 75 65 73 74 0a 23 0a 70 72 6f 63 20 68 Request.#.proc h
0150: 74 74 70 5f 67 65 74 20 7b 63 68 20 68 6f 73 74 ttp_get {ch host
0160: 20 70 61 74 68 20 70 72 6f 74 6f 63 6f 6c 7d 20 path protocol}
0170: 7b 0a 20 20 20 20 70 75 74 73 20 24 63 68 20 5b {. puts $ch [
0180: 66 6f 72 6d 61 74 20 22 47 45 54 20 25 73 20 25 format "GET %s %
0190: 73 22 20 24 70 61 74 68 20 5b 73 74 72 69 6e 67 s" $path [string
01a0: 20 74 6f 75 70 70 65 72 20 24 70 72 6f 74 6f 63 toupper $protoc
01b0: 6f 6c 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 63 ol]]. puts $c
01c0: 68 20 5b 66 6f 72 6d 61 74 20 22 55 73 65 72 2d h [format "User-
01d0: 41 67 65 6e 74 3a 20 4d 6f 7a 69 6c 6c 61 2f 34 Agent: Mozilla/4
01e0: 2e 30 20 28 63 6f 6d 70 61 74 69 62 6c 65 3b 20 .0 (compatible;
01f0: 25 73 29 22 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 %s)" $::tcl_plat
0200: 66 6f 72 6d 28 6f 73 29 5d 0a 20 20 20 20 70 75 form(os)]. pu
0210: 74 73 20 24 63 68 20 5b 66 6f 72 6d 61 74 20 22 ts $ch [format "
0220: 48 6f 73 74 3a 20 25 73 22 20 24 68 6f 73 74 5d Host: %s" $host]
0230: 0a 20 20 20 20 70 75 74 73 20 24 63 68 20 5b 66 . puts $ch [f
0240: 6f 72 6d 61 74 20 22 43 6f 6e 6e 65 63 74 69 6f ormat "Connectio
0250: 6e 3a 20 63 6c 6f 73 65 22 5d 0a 20 20 20 20 70 n: close"]. p
0260: 75 74 73 20 24 63 68 20 22 22 0a 20 20 20 20 66 uts $ch "". f
0270: 6c 75 73 68 20 24 63 68 0a 7d 0a 0a 23 20 53 61 lush $ch.}..# Sa
0280: 76 65 20 72 65 74 75 72 6e 65 64 20 64 61 74 61 ve returned data
0290: 20 74 6f 20 66 69 6c 65 0a 70 72 6f 63 20 73 61 to file.proc sa
02a0: 76 65 5f 66 69 6c 65 20 7b 66 69 6c 65 6e 61 6d ve_file {filenam
02b0: 65 20 64 61 74 61 7d 20 7b 0a 20 20 20 20 69 66 e data} {. if
02c0: 20 7b 5b 63 61 74 63 68 20 7b 6f 70 65 6e 20 24 {[catch {open $
02d0: 66 69 6c 65 6e 61 6d 65 20 77 62 7d 20 63 68 5d filename wb} ch]
02e0: 7d 20 7b 0a 09 72 65 74 75 72 6e 20 2d 63 6f 64 } {..return -cod
02f0: 65 20 65 72 72 6f 72 20 24 63 68 0a 20 20 20 20 e error $ch.
0300: 7d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 }. fconfigure
0310: 20 24 63 68 20 2d 62 75 66 66 65 72 73 69 7a 65 $ch -buffersize
0320: 20 31 36 33 38 34 20 2d 65 6e 63 6f 64 69 6e 67 16384 -encoding
0330: 20 75 74 66 2d 38 20 2d 74 72 61 6e 73 6c 61 74 utf-8 -translat
0340: 69 6f 6e 20 63 72 6c 66 0a 20 20 20 20 70 75 74 ion crlf. put
0350: 73 20 24 63 68 20 24 64 61 74 61 0a 20 20 20 20 s $ch $data.
0360: 63 6c 6f 73 65 20 24 63 68 0a 7d 0a 0a 0a 0a 70 close $ch.}....p
0370: 72 6f 63 20 67 65 74 73 5f 62 6c 6f 63 6b 69 6e roc gets_blockin
0380: 67 5f 6e 6f 5f 76 61 72 69 61 62 6c 65 20 7b 68 g_no_variable {h
0390: 6f 73 74 20 70 6f 72 74 20 70 61 74 68 20 70 72 ost port path pr
03a0: 6f 74 6f 63 6f 6c 7d 20 7b 0a 20 20 20 20 73 65 otocol} {. se
03b0: 74 20 72 65 73 75 6c 74 20 22 22 0a 0a 20 20 20 t result ""..
03c0: 20 23 20 4f 70 65 6e 20 73 6f 63 6b 65 74 0a 20 # Open socket.
03d0: 20 20 20 73 65 74 20 63 68 20 5b 3a 3a 74 6c 73 set ch [::tls
03e0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
03f0: 6e 61 6d 65 20 24 68 6f 73 74 20 2d 72 65 71 75 name $host -requ
0400: 65 73 74 20 31 20 2d 72 65 71 75 69 72 65 20 31 est 1 -require 1
0410: 20 2d 61 6c 70 6e 20 5b 6c 69 73 74 20 5b 73 74 -alpn [list [st
0420: 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 24 70 72 ring tolower $pr
0430: 6f 74 6f 63 6f 6c 5d 5d 20 24 68 6f 73 74 20 24 otocol]] $host $
0440: 70 6f 72 74 5d 0a 20 20 20 20 63 68 61 6e 20 63 port]. chan c
0450: 6f 6e 66 69 67 75 72 65 20 24 63 68 20 2d 62 6c onfigure $ch -bl
0460: 6f 63 6b 69 6e 67 20 31 20 2d 62 75 66 66 65 72 ocking 1 -buffer
0470: 69 6e 67 20 6c 69 6e 65 20 2d 62 75 66 66 65 72 ing line -buffer
0480: 73 69 7a 65 20 31 36 33 38 34 20 2d 65 6e 63 6f size 16384 -enco
0490: 64 69 6e 67 20 75 74 66 2d 38 20 2d 74 72 61 6e ding utf-8 -tran
04a0: 73 6c 61 74 69 6f 6e 20 7b 61 75 74 6f 20 63 72 slation {auto cr
04b0: 6c 66 7d 0a 0a 20 20 20 20 23 20 49 6e 69 74 69 lf}.. # Initi
04c0: 61 74 65 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 ate handshake.
04d0: 20 20 3a 3a 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ::tls::handsha
04e0: 6b 65 20 24 63 68 0a 20 20 20 20 61 66 74 65 72 ke $ch. after
04f0: 20 31 30 30 30 0a 0a 20 20 20 20 23 20 53 65 6e 1000.. # Sen
0500: 64 20 67 65 74 20 72 65 71 75 65 73 74 0a 20 20 d get request.
0510: 20 20 68 74 74 70 5f 67 65 74 20 24 63 68 20 24 http_get $ch $
0520: 68 6f 73 74 20 24 70 61 74 68 20 24 70 72 6f 74 host $path $prot
0530: 6f 63 6f 6c 0a 20 20 20 20 61 66 74 65 72 20 31 ocol. after 1
0540: 30 30 30 0a 0a 20 20 20 20 23 20 47 65 74 20 64 000.. # Get d
0550: 61 74 61 0a 20 20 20 20 77 68 69 6c 65 20 7b 31 ata. while {1
0560: 7d 20 7b 0a 09 73 65 74 20 6c 69 6e 65 20 5b 67 } {..set line [g
0570: 65 74 73 20 24 63 68 5d 0a 09 69 66 20 7b 21 28 ets $ch]..if {!(
0580: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
0590: 6c 69 6e 65 5d 20 3d 3d 20 30 20 26 26 20 5b 65 line] == 0 && [e
05a0: 6f 66 20 24 63 68 5d 29 7d 20 7b 0a 09 20 20 20 of $ch])} {..
05b0: 20 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 24 append result $
05c0: 6c 69 6e 65 20 22 5c 6e 22 0a 09 7d 20 65 6c 73 line "\n"..} els
05d0: 65 69 66 20 7b 5b 65 6f 66 20 24 63 68 5d 7d 20 eif {[eof $ch]}
05e0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 63 68 {.. close $ch
05f0: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
0600: 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 20 }. return
0610: 24 72 65 73 75 6c 74 0a 7d 0a 0a 73 61 76 65 5f $result.}..save_
0620: 66 69 6c 65 20 22 67 65 74 73 5f 62 6c 6f 63 6b file "gets_block
0630: 69 6e 67 5f 6e 6f 5f 76 61 72 69 61 62 6c 65 2e ing_no_variable.
0640: 74 78 74 22 20 5b 67 65 74 73 5f 62 6c 6f 63 6b txt" [gets_block
0650: 69 6e 67 5f 6e 6f 5f 76 61 72 69 61 62 6c 65 20 ing_no_variable
0660: 24 68 6f 73 74 20 24 70 6f 72 74 20 24 70 61 74 $host $port $pat
0670: 68 20 24 70 72 6f 74 6f 63 6f 6c 5d 0a h $protocol].