[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