Hi Paolo,
the first patches are various refactorings to the URIResolver code, the later
fixes some bugs (okay you have pushed a fix for the SSL issue anyway) that I
have encountered while trying to use the HTTPClient for SoapOpera.
cheers
holger
>From 7c44217798e5572ceb06a224dd97da0407d3d374 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Sun, 6 Mar 2011 16:03:17 +0100
Subject: [PATCH 1/7] netclients: Create URIResolver>>#defaultHeaders
Align the HTTP GET/POST/HEAD code and share the HTTP header
construction code in those.
---
packages/net/ChangeLog | 4 ++++
packages/net/URIResolver.st | 26 ++++++++++++++------------
2 files changed, 18 insertions(+), 12 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index 0fbd2e5..84e6d35 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,3 +1,7 @@
+2011-03-06 Holger Hans Peter Freyther <[email protected]>
+
+ * URIResolver.st: Add #defaultHeaders for HTTP.
+
2011-01-11 Paolo Bonzini <[email protected]>
* gnutls-wrapper.c: Support older GnuTLS.
diff --git a/packages/net/URIResolver.st b/packages/net/URIResolver.st
index f3eafbd..1c52658 100644
--- a/packages/net/URIResolver.st
+++ b/packages/net/URIResolver.st
@@ -75,6 +75,17 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
^entity stream
]
+ defaultHeaders [
+ "The default headers for HTTP like requests"
+ | requestHeaders |
+ requestHeaders := OrderedCollection new.
+ requestHeaders add: 'User-Agent: GNU-Smalltalk/' , Smalltalk version.
+ requestHeaders add: 'Accept: text/html, image/gif, */*; q=0.2'.
+ noCache ifTrue: [requestHeaders add: 'Pragma: no-cache'].
+
+ ^ requestHeaders
+ ]
+
connectClient [
<category: 'private'>
| host |
@@ -494,11 +505,8 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
requestHttpContents: urlString [
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
- requestHeaders := OrderedCollection new.
- requestHeaders add: 'User-Agent: GNU-Smalltalk/' , Smalltalk version.
- requestHeaders add: 'Accept: text/html, image/gif, */*; q=0.2'.
+ requestHeaders := self defaultHeaders.
requestHeaders add: 'Host: ' , url host.
- noCache ifTrue: [requestHeaders add: 'Pragma: no-cache'].
client reporter statusString: 'Connecting'.
protocolError := false.
client reporter
@@ -568,11 +576,8 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
requestHttpHead: urlString [
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
- requestHeaders := OrderedCollection new.
- requestHeaders add: 'User-Agent: GNU-Smalltalk/' , Smalltalk version.
- requestHeaders add: 'Accept: text/html, image/gif, */*; q=0.2'.
+ requestHeaders := self defaultHeaders.
requestHeaders add: 'Host: ' , url host.
- noCache ifTrue: [requestHeaders add: 'Pragma: no-cache'].
client reporter statusString: 'Connecting'.
client reporter
statusString: 'Connect: Host contacted. Waiting for reply...'.
@@ -645,10 +650,7 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
postHttpContents: contents urlString: urlString [
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
- requestHeaders := OrderedCollection new.
- requestHeaders add: 'User-Agent: GNU-Smalltalk/' , Smalltalk version.
- requestHeaders add: 'Accept: text/html, image/gif, */*; q=0.2'.
- noCache ifTrue: [requestHeaders add: 'Pragma: no-cache'].
+ requestHeaders := self defaultHeaders.
client reporter
statusString: 'Connect: Host contacted. Waiting for reply...'.
stream := self tmpFile.
--
1.7.4
>From 86946b6637b1e61f80e6d69d51f90ea886b12ae2 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Sun, 6 Mar 2011 16:06:40 +0100
Subject: [PATCH 2/7] netclients: Always set Host in the HTTP header
It looks like a mistake that the post code did not
set the host header. Fix it by setting it in the
defaultHeaders method.
---
packages/net/ChangeLog | 4 ++++
packages/net/URIResolver.st | 3 +--
2 files changed, 5 insertions(+), 2 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index 84e6d35..3453547 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,5 +1,9 @@
2011-03-06 Holger Hans Peter Freyther <[email protected]>
+ * URIResolver.st: Always set the 'Host' header for HTTP.
+
+2011-03-06 Holger Hans Peter Freyther <[email protected]>
+
* URIResolver.st: Add #defaultHeaders for HTTP.
2011-01-11 Paolo Bonzini <[email protected]>
diff --git a/packages/net/URIResolver.st b/packages/net/URIResolver.st
index 1c52658..c2dc296 100644
--- a/packages/net/URIResolver.st
+++ b/packages/net/URIResolver.st
@@ -81,6 +81,7 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
requestHeaders := OrderedCollection new.
requestHeaders add: 'User-Agent: GNU-Smalltalk/' , Smalltalk version.
requestHeaders add: 'Accept: text/html, image/gif, */*; q=0.2'.
+ requestHeaders add: 'Host: ' , url host.
noCache ifTrue: [requestHeaders add: 'Pragma: no-cache'].
^ requestHeaders
@@ -506,7 +507,6 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
requestHeaders := self defaultHeaders.
- requestHeaders add: 'Host: ' , url host.
client reporter statusString: 'Connecting'.
protocolError := false.
client reporter
@@ -577,7 +577,6 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
requestHeaders := self defaultHeaders.
- requestHeaders add: 'Host: ' , url host.
client reporter statusString: 'Connecting'.
client reporter
statusString: 'Connect: Host contacted. Waiting for reply...'.
--
1.7.4
>From b062f5753ede71723cc65204059c3dfa6ecc841a Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Sun, 6 Mar 2011 18:10:46 +0100
Subject: [PATCH 3/7] netclient: URIResolver>>#postHttpContents align with getHttpContents
---
packages/net/ChangeLog | 4 ++++
packages/net/URIResolver.st | 7 ++++---
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index 3453547..be27e30 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,5 +1,9 @@
2011-03-06 Holger Hans Peter Freyther <[email protected]>
+ * URIResolver.st: Align GET and POST for HTTP.
+
+2011-03-06 Holger Hans Peter Freyther <[email protected]>
+
* URIResolver.st: Always set the 'Host' header for HTTP.
2011-03-06 Holger Hans Peter Freyther <[email protected]>
diff --git a/packages/net/URIResolver.st b/packages/net/URIResolver.st
index c2dc296..d126c7c 100644
--- a/packages/net/URIResolver.st
+++ b/packages/net/URIResolver.st
@@ -650,11 +650,12 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
<category: 'http accessing'>
| requestHeaders tmpFile stream protocolError response string |
requestHeaders := self defaultHeaders.
+ client reporter statusString: 'Connecting'.
+ protocolError := false.
client reporter
statusString: 'Connect: Host contacted. Waiting for reply...'.
stream := self tmpFile.
tmpFile := stream file.
- protocolError := false.
[
[
@@ -698,14 +699,14 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
body: string;
url: url;
canCache: false;
- guessMimeTypeFromResponse: response;
+ guessMimeType;
yourself]
ifFalse:
[(WebEntity new)
url: url;
canCache: false;
localFileName: tmpFile name;
- guessMimeTypeFromResponse: response;
+ guessMimeType;
yourself]
]
--
1.7.4
>From 20123694392464a73dc613017cd2edcfef391f4b Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Mon, 7 Mar 2011 15:33:33 +0100
Subject: [PATCH 4/7] netclient: Refactor code for handling a HTTP response
---
packages/net/ChangeLog | 4 ++
packages/net/URIResolver.st | 89 +++++++++++--------------------------------
2 files changed, 26 insertions(+), 67 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index be27e30..bdf845e 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,3 +1,7 @@
+2011-03-07 Holger Hans Peter Freyther <[email protected]>
+
+ * URIResolver.st: Add #doHTTPRequest and use it.
+
2011-03-06 Holger Hans Peter Freyther <[email protected]>
* URIResolver.st: Align GET and POST for HTTP.
diff --git a/packages/net/URIResolver.st b/packages/net/URIResolver.st
index d126c7c..247f2d8 100644
--- a/packages/net/URIResolver.st
+++ b/packages/net/URIResolver.st
@@ -503,8 +503,8 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
^self requestHttpContents: url requestString
]
- requestHttpContents: urlString [
- <category: 'http accessing'>
+ doHTTPRequest: requestBlock onSuccess: successBlock [
+ <category: 'private'>
| requestHeaders tmpFile stream protocolError response string |
requestHeaders := self defaultHeaders.
client reporter statusString: 'Connecting'.
@@ -516,10 +516,7 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
[
[
- [response := client
- get: urlString
- requestHeaders: requestHeaders
- into: stream]
+ [response := requestBlock value: requestHeaders value: stream]
ensure: [client close]]
on: NetClientError
do: [:ex | ^self errorContents: ex messageText]
@@ -556,12 +553,22 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
guessMimeType;
yourself]
ifFalse:
- [(WebEntity new)
- url: url;
- canCache: noCache not;
- localFileName: tmpFile name;
- guessMimeType;
- yourself]
+ [|ent |
+ ent := (WebEntity new)
+ url: url;
+ localFileName: tmpFile name;
+ canCache: noCache not;
+ guessMimeType;
+ yourself.
+ successBlock value: ent.
+ ent]
+ ]
+
+ requestHttpContents: urlString [
+ <category: 'http accessing'>
+ ^ self doHTTPRequest: [:requestHeaders :stream |
+ client get: urlString requestHeaders: requestHeaders into: stream]
+ onSuccess: [:ent | ]
]
getHttpHead [
@@ -648,66 +655,14 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
postHttpContents: contents urlString: urlString [
<category: 'http accessing'>
- | requestHeaders tmpFile stream protocolError response string |
- requestHeaders := self defaultHeaders.
- client reporter statusString: 'Connecting'.
- protocolError := false.
- client reporter
- statusString: 'Connect: Host contacted. Waiting for reply...'.
- stream := self tmpFile.
- tmpFile := stream file.
-
- [
- [
- [response := client
- post: urlString
+ ^ self doHTTPRequest: [:requestHeaders :stream |
+ client post: urlString
type: contents type
data: contents asStringOrByteArray
binary: contents isBinary
requestHeaders: requestHeaders
into: stream]
- ensure: [client close]]
- on: NetClientError
- do: [:ex | ^self errorContents: ex messageText]
- on: ProtocolError
- do:
- [:ex |
- protocolError := true.
- ex pass]
- on: HTTP.HTTPRedirection
- do:
- [:ex |
- | location |
- location := ex tag.
- location isNil
- ifTrue: [^self errorContents: 'Moved elsewhere']
- ifFalse:
- [client reporter statusString: 'Redirecting'.
- stream close.
- stream := nil.
- tmpFile exists ifTrue: [tmpFile remove].
- ^(self class on: (url construct: (URL fromString: location)))
- noCache: self noCache;
- reporter: self reporter;
- contents]]]
- ensure: [stream isNil ifFalse: [stream close]].
- ^protocolError
- ifTrue:
- [string := tmpFile contents.
- tmpFile remove.
- (WebEntity new)
- body: string;
- url: url;
- canCache: false;
- guessMimeType;
- yourself]
- ifFalse:
- [(WebEntity new)
- url: url;
- canCache: false;
- localFileName: tmpFile name;
- guessMimeType;
- yourself]
+ onSuccess: [:ent | ent canCache: false ]
]
emptyMessage [
--
1.7.4
>From 6579388f0ad3c9895ded4409def4b7869a3c8789 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Mon, 7 Mar 2011 16:07:06 +0100
Subject: [PATCH 5/7] netclient: Unbreak the GnuTLS support by calling gnutls_set_default_priority
Older versions of GnuTLS lack the gnutls_priority_set_direct method and in
6c08f8dabb50d7c64a4ee193bf42eac3d9be9130 we have removed that call and that
makes the code not work on newer GnuTLS. Use the gnutls_set_default_priority
method to use the default encoding and algorithms.
---
packages/net/ChangeLog | 4 ++++
packages/net/gnutls-wrapper.c | 1 +
2 files changed, 5 insertions(+), 0 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index bdf845e..a1c75a9 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,5 +1,9 @@
2011-03-07 Holger Hans Peter Freyther <[email protected]>
+ * gnutls-wrapper.c: Use gnutls_set_default_priority.
+
+2011-03-07 Holger Hans Peter Freyther <[email protected]>
+
* URIResolver.st: Add #doHTTPRequest and use it.
2011-03-06 Holger Hans Peter Freyther <[email protected]>
diff --git a/packages/net/gnutls-wrapper.c b/packages/net/gnutls-wrapper.c
index 9163c32..0468aa4 100644
--- a/packages/net/gnutls-wrapper.c
+++ b/packages/net/gnutls-wrapper.c
@@ -147,6 +147,7 @@ main (int argc, char **argv)
sockets_init ();
gnutls_init (&session, GNUTLS_CLIENT);
+ gnutls_set_default_priority(session);
gnutls_anon_allocate_client_credentials (&anon_cred);
gnutls_credentials_set (session, GNUTLS_CRD_ANON, anon_cred);
--
1.7.4
>From fde87bf86e79191193037dc0f7398426af2219c6 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Mon, 7 Mar 2011 16:55:10 +0100
Subject: [PATCH 6/7] netclient: Fix DNU when connecting to non existing server
NetClients.HTTP.HTTPClient connectToTost: 'blafoo.gnu.org' port: 80.
triggered a DNU.
---
packages/net/Base.st | 2 +-
packages/net/ChangeLog | 4 ++++
2 files changed, 5 insertions(+), 1 deletions(-)
diff --git a/packages/net/Base.st b/packages/net/Base.st
index b37298b..4ef04b4 100644
--- a/packages/net/Base.st
+++ b/packages/net/Base.st
@@ -437,7 +437,7 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
ex.
messageText := ex messageText.
ex return: nil].
- connection isNil ifTrue: [^self connectionFailedError: messageText].
+ connection isNil ifTrue: [^self clientPI connectionFailedError: messageText].
self connectionStream: connection.
self clientPI connected.
]
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index a1c75a9..06b170e 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,5 +1,9 @@
2011-03-07 Holger Hans Peter Freyther <[email protected]>
+ * Base.st: Call connectionFailedError of NetProtocolInterpreter.
+
+2011-03-07 Holger Hans Peter Freyther <[email protected]>
+
* gnutls-wrapper.c: Use gnutls_set_default_priority.
2011-03-07 Holger Hans Peter Freyther <[email protected]>
--
1.7.4
>From 90c4880bd2055ba57cf1e8f9d44780b8ed88d6e6 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <[email protected]>
Date: Thu, 10 Mar 2011 16:10:50 +0100
Subject: [PATCH 7/7] net: Flush the stream in the POST method
If the stream is not flushed the data might not be transfered
to the HTTP Server and our waiting for a response will not be
very successfull.
---
packages/net/ChangeLog | 4 ++++
packages/net/HTTP.st | 2 +-
2 files changed, 5 insertions(+), 1 deletions(-)
diff --git a/packages/net/ChangeLog b/packages/net/ChangeLog
index 06b170e..74eefc3 100644
--- a/packages/net/ChangeLog
+++ b/packages/net/ChangeLog
@@ -1,3 +1,7 @@
+2011-03-10 Holger Hans Peter Freyther <[email protected]>
+
+ * HTTP.st: Flush the binary stream.
+
2011-03-07 Holger Hans Peter Freyther <[email protected]>
* Base.st: Call connectionFailedError of NetProtocolInterpreter.
diff --git a/packages/net/HTTP.st b/packages/net/HTTP.st
index 2f83fac..dc0653c 100644
--- a/packages/net/HTTP.st
+++ b/packages/net/HTTP.st
@@ -293,7 +293,7 @@ Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
cr.
self putRequestHeaders: requestHeaders.
binary
- ifTrue: [self connectionStream stream nextPutAll: data]
+ ifTrue: [(self connectionStream stream) nextPutAll: data; flush]
ifFalse: [self nextPutAll: data].
^self readResponseInto: aStream
]
--
1.7.4
_______________________________________________
help-smalltalk mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/help-smalltalk
