[svn:parrot] r46848 - in trunk: runtime/parrot/library runtime/parrot/library/HTTP t/library
fperrad at svn.parrot.org
fperrad at svn.parrot.org
Fri May 21 08:32:13 UTC 2010
Author: fperrad
Date: Fri May 21 08:32:13 2010
New Revision: 46848
URL: https://trac.parrot.org/parrot/changeset/46848
Log:
[LWP] proxy (step 1)
Modified:
trunk/runtime/parrot/library/HTTP/Message.pir
trunk/runtime/parrot/library/LWP.pir
trunk/t/library/lwp.t
Modified: trunk/runtime/parrot/library/HTTP/Message.pir
==============================================================================
--- trunk/runtime/parrot/library/HTTP/Message.pir Fri May 21 08:15:34 2010 (r46847)
+++ trunk/runtime/parrot/library/HTTP/Message.pir Fri May 21 08:32:13 2010 (r46848)
@@ -175,6 +175,7 @@
$P0 = subclass ['HTTP';'Message'], ['HTTP';'Request']
$P0.'add_attribute'('method')
$P0.'add_attribute'('uri')
+ $P0.'add_attribute'('proxy')
.end
=item method
@@ -195,6 +196,17 @@
.return ($P0)
.end
+.sub 'proxy' :method
+ .param pmc val :optional
+ .param int has_val :opt_flag
+ unless has_val goto L1
+ setattribute self, 'proxy', val
+ .return ()
+ L1:
+ $P0 = getattribute self, 'proxy'
+ .return ($P0)
+.end
+
=item GET
=cut
@@ -467,7 +479,7 @@
L2:
$S0 = $P0
.local pmc encode
- encode = get_hll_global ['MIME';'Base64'], 'encode_base64'
+ encode = get_hll_global ['MIME';'Base64'], 'encode_base64'
$S0 = encode($S0)
$I1 = length $S0
$I0 = 0
Modified: trunk/runtime/parrot/library/LWP.pir
==============================================================================
--- trunk/runtime/parrot/library/LWP.pir Fri May 21 08:15:34 2010 (r46847)
+++ trunk/runtime/parrot/library/LWP.pir Fri May 21 08:32:13 2010 (r46848)
@@ -27,6 +27,8 @@
$P0.'add_attribute'('progress_lastp')
$P0.'add_attribute'('progress_ani')
$P0.'add_attribute'('max_redirect')
+ $P0.'add_attribute'('proxy')
+ $P0.'add_attribute'('no_proxy')
.globalconst int RC_OK = 200
.globalconst int RC_MOVED_PERMANENTLY = 301
.globalconst int RC_FOUND = 302
@@ -44,6 +46,10 @@
setattribute self, 'def_headers', $P0
$P0 = box 7
setattribute self, 'max_redirect', $P0
+ $P0 = new 'Hash'
+ setattribute self, 'proxy', $P0
+ $P0 = new 'ResizableStringArray'
+ setattribute self, 'no_proxy', $P0
.end
.sub 'send_request' :method
@@ -55,20 +61,25 @@
.local string scheme
scheme = url.'scheme'()
self.'progress'('begin', request)
+ .local pmc proxy
+ proxy = request.'proxy'()
+ if null proxy goto L1
+ scheme = proxy.'scheme'()
+ L1:
.local pmc protocol, response
$P0 =get_hll_global ['LWP';'Protocol'], 'create'
protocol = $P0(scheme, self)
- unless null protocol goto L1
+ unless null protocol goto L2
response = _new_response(request, RC_NOT_IMPLEMENTED, 'Not Implemented')
- goto L2
- L1:
- response = protocol.'request'(request)
+ goto L3
+ L2:
+ response = protocol.'request'(request, proxy)
setattribute response, 'request', request
$P0 = get_hll_global ['HTTP';'Date'], 'time2str'
$I0 = time
$S0 = $P0($I0)
response.'push_header'('Client-Date', $S0)
- L2:
+ L3:
self.'progress'('end', response)
.return (response)
.end
@@ -87,6 +98,7 @@
unless $S0 == '' goto L3
die "URL must be absolute"
L3:
+ self.'_need_proxy'(request)
$P0 = getattribute self, 'def_headers'
$P1 = iter $P0
L4:
@@ -199,6 +211,19 @@
.tailcall self.'request'(request)
.end
+=item head
+
+=cut
+
+.sub 'head' :method
+ .param pmc args :slurpy
+ .param pmc kv :slurpy :named
+ .local pmc request
+ $P0 = get_hll_global ['HTTP';'Request'], 'HEAD'
+ request = $P0(args :flat, kv :flat :named)
+ .tailcall self.'request'(request)
+.end
+
=item post
=cut
@@ -347,6 +372,35 @@
$P0['User-Agent'] = val
.end
+.sub '_need_proxy' :method
+ .param pmc req
+ $P0 = req.'proxy'()
+ unless null $P0 goto L1
+ .local pmc uri
+ uri = req.'uri'()
+ .local string scheme
+ scheme = uri.'scheme'()
+ $P0 = getattribute self, 'proxy'
+ .local string proxy
+ proxy = $P0[scheme]
+ unless proxy goto L1
+ .local string host
+ host = uri.'host'()
+ $P0 = getattribute self, 'no_proxy'
+ $P1 = iter $P0
+ L2:
+ unless $P1 goto L3
+ $S0 = shift $P1
+ $I0 = index host, $S0
+ if $I0 < 0 goto L2
+ goto L1
+ L3:
+ $P0 = get_hll_global ['URI'], 'new_from_string'
+ $P0 = $P0(proxy)
+ req.'proxy'($P0)
+ L1:
+.end
+
=item env_provy
=cut
@@ -358,10 +412,84 @@
unless $P1 goto L2
$S0 = shift $P1
$S1 = downcase $S0
+ $I0 = index $S1, '_proxy'
+ if $I0 < 0 goto L1
+ $S2 = $P0[$S0]
+ unless $S1 == 'no_proxy' goto L3
+ $P2 = split ',', $S2
+ $P3 = iter $P2
+ L4:
+ unless $P3 goto L1
+ $S0 = shift $P3
+ $S0 = trim($S0)
+ self.'no_proxy'($S0)
+ goto L4
+ L3:
+ $S3 = substr $S1, 0, $I0
+ # Ignore xxx_proxy variables if xxx isn't a supported protocol
+ $P11 = new 'Key'
+ set $P11, 'LWP'
+ $P12 = new 'Key'
+ set $P12, 'Protocol'
+ push $P11, $P12
+ $P13 = new 'Key'
+ set $P13, $S3
+ push $P11, $P13
+ $P10 = get_class $P11
+ if null $P10 goto L1
+ self.'proxy'($S3, $S2)
+ goto L1
+ L2:
+.end
- # work in progress
+.include 'cclass.pasm'
- goto L1
+.sub 'trim' :anon
+ .param string str
+ $I0 = length str
+ $I0 = find_not_cclass .CCLASS_WHITESPACE, str, 0, $I0
+ str = substr str, $I0
+ $I0 = length str
+ L1:
+ dec $I0
+ unless $I0 > 0 goto L2
+ $I1 = is_cclass .CCLASS_WHITESPACE, str, $I0
+ if $I1 != 0 goto L1
+ L2:
+ inc $I0
+ str = substr str, 0, $I0
+ .return (str)
+.end
+
+=item proxy
+
+=cut
+
+.sub 'proxy' :method
+ .param string scheme
+ .param string url
+ $P0 = getattribute self, 'proxy'
+ $P0[scheme] = url
+.end
+
+=item no_proxy
+
+=cut
+
+.sub 'no_proxy' :method
+ .param pmc args :slurpy
+ $I0 = elements args
+ if $I0 goto L1
+ $P0 = new 'ResizableStringArray'
+ setattribute self, 'no_proxy', $P0
+ goto L2
+ L1:
+ $P0 = getattribute self, 'no_proxy'
+ L3:
+ unless args goto L2
+ $S0 = shift args
+ push $P0, $S0
+ goto L3
L2:
.end
@@ -460,6 +588,8 @@
=head3 Class LWP;Protocol;file
+=over 4
+
=cut
.namespace ['LWP';'Protocol';'file']
@@ -470,13 +600,26 @@
$P0 = subclass ['LWP';'Protocol'], ['LWP';'Protocol';'file']
.end
+=item request
+
+=cut
+
.sub 'request' :method
.param pmc request
+ .param pmc proxy
+ if null proxy goto L1
+ $P0 = new ['HTTP';'Response']
+ $P1 = box RC_BAD_REQUEST
+ setattribute $P0, 'code', $P1
+ $P1 = box 'You can not proxy through the filesystem'
+ setattribute $P0, 'message', $P1
+ .return ($P0)
+ L1:
load_bytecode 'osutils.pbc'
.local string method
method = request.'method'()
$P0 = get_hll_global ['LWP';'Protocol';'file'], method
- unless null $P0 goto L1
+ unless null $P0 goto L2
$P0 = new ['HTTP';'Response']
$P1 = box RC_BAD_REQUEST
setattribute $P0, 'code', $P1
@@ -485,12 +628,12 @@
$P1 = box $S0
setattribute $P0, 'message', $P1
.return ($P0)
- L1:
+ L2:
.local pmc url
url = request.'uri'()
.local string scheme
scheme = url.'scheme'()
- if scheme == 'file' goto L2
+ if scheme == 'file' goto L3
$P0 = new ['HTTP';'Response']
$P1 = box RC_INTERNAL_SERVER_ERROR
setattribute $P0, 'code', $P1
@@ -499,7 +642,7 @@
$P1 = box $S0
setattribute $P0, 'message', $P1
.return ($P0)
- L2:
+ L3:
.tailcall $P0(self, request)
.end
@@ -630,8 +773,12 @@
.return (response)
.end
+=back
+
=head3 Class LWP;Protocol;http
+=over 4
+
=cut
.namespace ['LWP';'Protocol';'http']
@@ -656,6 +803,8 @@
.sub '_fixup_header' :method
.param pmc headers
.param pmc url
+ .param pmc proxy
+ # Extract 'Host' header
.local string host
host = url.'authority'()
headers['Host'] = host
@@ -762,8 +911,13 @@
L2:
.end
+=item request
+
+=cut
+
.sub 'request' :method
.param pmc request
+ .param pmc proxy
.local string method
method = request.'method'()
@@ -784,7 +938,7 @@
.local pmc request_headers
request_headers = request.'headers'()
- self.'_fixup_header'(request_headers, url)
+ self.'_fixup_header'(request_headers, url, proxy)
.local pmc ua
ua = self.'ua'()
@@ -838,6 +992,8 @@
.return (response)
.end
+=back
+
=head1 AUTHOR
Francois Perrad
Modified: trunk/t/library/lwp.t
==============================================================================
--- trunk/t/library/lwp.t Fri May 21 08:15:34 2010 (r46847)
+++ trunk/t/library/lwp.t Fri May 21 08:32:13 2010 (r46848)
@@ -22,13 +22,15 @@
load_bytecode 'LWP.pir'
load_bytecode 'osutils.pbc'
- plan(38)
+ plan(48)
test_new()
test_unknown_protocol()
test_bad_request()
test_file_not_found()
test_file()
+ test_file_head()
test_file_post_delete()
+ test_file_proxy()
.end
.sub 'test_new'
@@ -127,6 +129,28 @@
ok($I0, "Last-Modified contains GMT")
.end
+.sub 'test_file_head'
+ .local pmc ua, response
+ ua = new ['LWP';'UserAgent']
+ response = ua.'head'('file:t/library/lwp.t')
+ $I0 = isa response, ['HTTP';'Response']
+ ok($I0, "HEAD file:t/library/lwp.t")
+ $I0 = response.'code'()
+ is($I0, 200, "code")
+ $I0 = response.'is_success'()
+ ok($I0, "is success")
+ $S0 = response.'content'()
+ is($S0, '', "no content")
+ $I0 = response.'get_header'('Content-Length')
+ $I0 = $I0 > 2000
+ ok($I0, "Content-Length")
+ $S0 = response.'get_header'('Last-Modified')
+ diag($S0)
+ $I0 = index $S0, 'GMT'
+ $I0 = $I0 > 0
+ ok($I0, "Last-Modified contains GMT")
+.end
+
.sub 'test_file_post_delete'
.const string data = "the file contains some text"
.const string filename = 't/library/file.txt'
@@ -138,7 +162,7 @@
response = ua.'put'(url, data)
$I0 = isa response, ['HTTP';'Response']
- ok($I0, "POST file:t/library/file.txt")
+ ok($I0, "PUT file:t/library/file.txt")
$I0 = response.'code'()
is($I0, 200, "code")
$I0 = response.'is_success'()
@@ -165,6 +189,21 @@
ok($I0, "is error")
.end
+.sub 'test_file_proxy'
+ .local pmc ua, response
+ ua = new ['LWP';'UserAgent']
+ ua.'proxy'('file', 'file://proxy.net')
+ response = ua.'get'('file:t/library/lwp.t')
+ $I0 = isa response, ['HTTP';'Response']
+ ok($I0, "GET file:t/library/lwp.t via a proxy")
+ $I0 = response.'code'()
+ is($I0, 400, "code")
+ $S0 = response.'message'()
+ is($S0, "You can not proxy through the filesystem", "message")
+ $I0 = response.'is_error'()
+ ok($I0, "is error")
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
More information about the parrot-commits
mailing list