]>
git.ipfire.org Git - thirdparty/squid.git/blob - test-suite/htcp-client.pl
3 ## Copyright (C) 1996-2018 The Squid Software Foundation and contributors
5 ## Squid software is distributed under GPLv2+ license and includes
6 ## contributions from numerous individuals and organizations.
7 ## Please see the COPYING and CONTRIBUTORS files for details.
13 # simple tool to send client HTCP queries
15 # only supports TST and CLR so far
33 print "sending $op $url to $server\n";
35 my $op_data = op_data
($op, $url);
38 my $data = data
($op_data, $opcodes{$op}, 0, 1, 0, rand 1<<31);
41 my $htcp = packet
($data, $auth);
43 my $sock = IO
::Socket
::INET
->new(PeerAddr
=> $server,
47 die "$server: $!" unless $sock;
49 $sock->send($htcp, 0) || die "send $server: $!";
55 my $hdr = header
(length($data) + length($auth));
56 printf STDERR
"hdr is %d bytes\n", length($hdr);
57 printf STDERR
"data is %d bytes\n", length($data);
58 printf STDERR
"auth is %d bytes\n", length($auth);
63 my $length = 4 + shift;
67 pack('nCC', $length, $major, $minor);
78 printf STDERR
"op_data is %d bytes\n", length($op_data);
79 printf STDERR
"response is %d\n", $response;
80 printf STDERR
"F1 is %d\n", $f1;
81 printf STDERR
"RR is %d\n", $rr;
82 my $length = 8 + length($op_data);
83 my $x1 = ($opcode & 0xF) | (($response & 0xF) << 4);
84 #my $x2 = ($rr & 0x1) | (($f1 & 0x1) << 1) | (($reserved & 0x3F) << 2);
85 my $x2 = ($reserved & 0x3F) | (($f1 & 0x1) << 6) | (($rr & 0x1) << 7);
86 pack('nCCNa*', $length, $x1, $x2, $trans_id, $op_data);
95 pack('na*', length($str), $str);
99 my $method = countstr
(shift);
100 my $uri = countstr
(shift);
101 my $version = countstr
(shift);
102 my $req_hdrs = countstr
(shift);
103 $method . $uri . $version . $req_hdrs;
109 my $specifier = shift;
110 printf STDERR
"CLR specifier is %d bytes\n", length($specifier);
111 my $x1 = ($reason & 0xF) | (($reserved & 0x7F) << 4);
112 pack('na*', $x1, $specifier);
116 my $specifier = shift;
117 printf STDERR
"TST specifier is %d bytes\n", length($specifier);
118 pack('a*', $specifier);
125 return clr
(1, specifier
('GET', $url, 'HTTP/1.1', "Accept: */*\r\n"));
126 } elsif ($op eq 'TST') {
127 return tst
(specifier
('GET', $url, 'HTTP/1.1', "Accept: */*\r\n"));
129 print STDERR
"unsupported HTCP opcode $op\n";