Fixed timeouts for sockets, implemented timeouts in httpclient and fixed

a bug with redirection in httpclient.

lib/pure/httpclient.nim

@@ -50,6 +50,18 @@
 ## any of the functions a url with the ``https`` schema, for example:
 ## ``https://github.com/``, you also have to compile with ``ssl`` defined like so:
 ## ``nimrod c -d:ssl ...``.
+##
+## Timeouts
+## ========
+## Currently all functions support an optional timeout, by default the timeout is set to
+## `-1` which means that the function will never time out. The timeout is
+## measured in miliseconds, once it is set any call on a socket which may
+## block will be susceptible to this timeout, however please remember that the
+## function as a whole can take longer than the specified timeout, only
+## individual internal calls on the socket are affected. In practice this means
+## that as long as the server is sending data an exception will not be raised,
+## if however data does not reach client within the specified timeout an ETimeout
+## exception will then be raised.
 
 import sockets, strutils, parseurl, parseutils, strtabs
 
@@ -68,6 +80,8 @@ type
                                       ## and ``postContent`` proc,
                                       ## when the server returns an error
 
+const defUserAgent* = "Nimrod httpclient/0.1"
+
 proc httpError(msg: string) =
   var e: ref EInvalidProtocol
   new(e)
@@ -80,13 +94,13 @@ proc fileError(msg: string) =
   e.msg = msg
   raise e
 
-proc parseChunks(s: TSocket): string =
+proc parseChunks(s: TSocket, timeout: int): string =
   result = ""
   var ri = 0
   while true:
     var chunkSizeStr = ""
     var chunkSize = 0
-    if s.recvLine(chunkSizeStr):
+    if s.recvLine(chunkSizeStr, timeout):
       var i = 0
       if chunkSizeStr == "":
         httpError("Server terminated connection prematurely")
@@ -111,18 +125,17 @@ proc parseChunks(s: TSocket): string =
     result.setLen(ri+chunkSize)
     var bytesRead = 0
     while bytesRead != chunkSize:
-      let ret = recv(s, addr(result[ri]), chunkSize-bytesRead)
+      let ret = recv(s, addr(result[ri]), chunkSize-bytesRead, timeout)
       ri += ret
       bytesRead += ret
-    s.skip(2) # Skip \c\L
+    s.skip(2, timeout) # Skip \c\L
     # Trailer headers will only be sent if the request specifies that we want
     # them: http://tools.ietf.org/html/rfc2616#section-3.6.1
   
-proc parseBody(s: TSocket,
-               headers: PStringTable): string =
+proc parseBody(s: TSocket, headers: PStringTable, timeout: int): string =
   result = ""
   if headers["Transfer-Encoding"] == "chunked":
-    result = parseChunks(s)
+    result = parseChunks(s, timeout)
   else:
     # -REGION- Content-Length
     # (http://tools.ietf.org/html/rfc2616#section-4.4) NR.3
@@ -133,7 +146,7 @@ proc parseBody(s: TSocket,
       var received = 0
       while true:
         if received >= length: break
-        let r = s.recv(addr(result[received]), length-received)
+        let r = s.recv(addr(result[received]), length-received, timeout)
         if r == 0: break
         received += r
       if received != length:
@@ -148,12 +161,12 @@ proc parseBody(s: TSocket,
         var buf = ""
         while True:
           buf = newString(4000)
-          let r = s.recv(addr(buf[0]), 4000)
+          let r = s.recv(addr(buf[0]), 4000, timeout)
           if r == 0: break
           buf.setLen(r)
           result.add(buf)
 
-proc parseResponse(s: TSocket, getBody: bool): TResponse =
+proc parseResponse(s: TSocket, getBody: bool, timeout: int): TResponse =
   var parsedStatus = false
   var linei = 0
   var fullyRead = false
@@ -162,7 +175,7 @@ proc parseResponse(s: TSocket, getBody: bool): TResponse =
   while True:
     line = ""
     linei = 0
-    if s.recvLine(line):
+    if s.recvLine(line, timeout):
       if line == "": break # We've been disconnected.
       if line == "\c\L":
         fullyRead = true
@@ -194,9 +207,11 @@ proc parseResponse(s: TSocket, getBody: bool): TResponse =
         linei += skipWhitespace(line, linei)
         
         result.headers[name] = line[linei.. -1]
-  if not fullyRead: httpError("Connection was closed before full request has been made")
+    else: SocketError(s)
+  if not fullyRead:
+    httpError("Connection was closed before full request has been made")
   if getBody:
-    result.body = parseBody(s, result.headers)
+    result.body = parseBody(s, result.headers, timeout)
   else:
     result.body = ""
 
@@ -227,9 +242,12 @@ else:
 
 proc request*(url: string, httpMethod = httpGET, extraHeaders = "", 
               body = "",
-              sslContext: PSSLContext = defaultSSLContext): TResponse =
+              sslContext: PSSLContext = defaultSSLContext,
+              timeout = -1, userAgent = defUserAgent): TResponse =
   ## | Requests ``url`` with the specified ``httpMethod``.
   ## | Extra headers can be specified and must be seperated by ``\c\L``
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
   var r = parseUrl(url)
   var headers = substr($httpMethod, len("http"))
   headers.add(" /" & r.path & r.query)
@@ -237,25 +255,32 @@ proc request*(url: string, httpMethod = httpGET, extraHeaders = "",
   headers.add(" HTTP/1.1\c\L")
   
   add(headers, "Host: " & r.hostname & "\c\L")
+  if userAgent != "":
+    add(headers, "User-Agent: " & userAgent & "\c\L")
   add(headers, extraHeaders)
   add(headers, "\c\L")
-
+  
   var s = socket()
   var port = TPort(80)
   if r.scheme == "https":
     when defined(ssl):
       sslContext.wrapSocket(s)
     else:
-      raise newException(EHttpRequestErr, "SSL support was not compiled in. Cannot connect over SSL.")
+      raise newException(EHttpRequestErr,
+                "SSL support is not available. Cannot connect over SSL.")
     port = TPort(443)
   if r.port != "":
     port = TPort(r.port.parseInt)
-  s.connect(r.hostname, port)
+  
+  if timeout == -1:
+    s.connect(r.hostname, port)
+  else:
+    s.connect(r.hostname, port, timeout)
   s.send(headers)
   if body != "":
     s.send(body)
   
-  result = parseResponse(s, httpMethod != httpHEAD)
+  result = parseResponse(s, httpMethod != httpHEAD, timeout)
   s.close()
   
 proc redirection(status: string): bool =
@@ -263,56 +288,94 @@ proc redirection(status: string): bool =
   for i in items(redirectionNRs):
     if status.startsWith(i):
       return True
+
+proc getNewLocation(lastUrl: string, headers: PStringTable): string =
+  result = headers["Location"]
+  if result == "": httpError("location header expected")
+  # Relative URLs. (Not part of the spec, but soon will be.)
+  let r = parseURL(result)
+  if r.hostname == "" and r.path != "":
+    let origParsed = parseURL(lastUrl)
+    result = origParsed.hostname & "/" & r.path
   
-proc get*(url: string, maxRedirects = 5, sslContext: PSSLContext = defaultSSLContext): TResponse =
+proc get*(url: string, extraHeaders = "", maxRedirects = 5,
+          sslContext: PSSLContext = defaultSSLContext,
+          timeout = -1, userAgent = defUserAgent): TResponse =
   ## | GETs the ``url`` and returns a ``TResponse`` object
   ## | This proc also handles redirection
-  result = request(url)
+  ## | Extra headers can be specified and must be separated by ``\c\L``.
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
+  result = request(url, httpGET, extraHeaders, "", sslContext, timeout, userAgent)
+  var lastURL = url
   for i in 1..maxRedirects:
     if result.status.redirection():
-      var locationHeader = result.headers["Location"]
-      if locationHeader == "": httpError("location header expected")
-      result = request(locationHeader, sslContext = sslContext)
+      let redirectTo = getNewLocation(lastURL, result.headers)
+      result = request(redirectTo, httpGET, extraHeaders, "", sslContext,
+                       timeout, userAgent)
+      lastUrl = redirectTo
       
-proc getContent*(url: string, sslContext: PSSLContext = defaultSSLContext): string =
+proc getContent*(url: string, extraHeaders = "", maxRedirects = 5,
+                 sslContext: PSSLContext = defaultSSLContext,
+                 timeout = -1, userAgent = defUserAgent): string =
   ## | GETs the body and returns it as a string.
   ## | Raises exceptions for the status codes ``4xx`` and ``5xx``
-  var r = get(url, sslContext = sslContext)
+  ## | Extra headers can be specified and must be separated by ``\c\L``.
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
+  var r = get(url, extraHeaders, maxRedirects, sslContext, timeout, userAgent)
   if r.status[0] in {'4','5'}:
     raise newException(EHTTPRequestErr, r.status)
   else:
     return r.body
   
-proc post*(url: string, extraHeaders = "", body = "", 
-           maxRedirects = 5, sslContext: PSSLContext = defaultSSLContext): TResponse =
+proc post*(url: string, extraHeaders = "", body = "",
+           maxRedirects = 5,
+           sslContext: PSSLContext = defaultSSLContext,
+           timeout = -1, userAgent = defUserAgent): TResponse =
   ## | POSTs ``body`` to the ``url`` and returns a ``TResponse`` object.
   ## | This proc adds the necessary Content-Length header.
   ## | This proc also handles redirection.
+  ## | Extra headers can be specified and must be separated by ``\c\L``.
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
   var xh = extraHeaders & "Content-Length: " & $len(body) & "\c\L"
-  result = request(url, httpPOST, xh, body, sslContext)
+  result = request(url, httpPOST, xh, body, sslContext, timeout, userAgent)
+  var lastUrl = ""
   for i in 1..maxRedirects:
     if result.status.redirection():
-      var locationHeader = result.headers["Location"]
-      if locationHeader == "": httpError("location header expected")
+      let redirectTo = getNewLocation(lastURL, result.headers)
       var meth = if result.status != "307": httpGet else: httpPost
-      result = request(locationHeader, meth, xh, body)
+      result = request(redirectTo, meth, xh, body, sslContext, timeout,
+                       userAgent)
+      lastUrl = redirectTo
   
 proc postContent*(url: string, extraHeaders = "", body = "",
-                  sslContext: PSSLContext = defaultSSLContext): string =
+                  maxRedirects = 5,
+                  sslContext: PSSLContext = defaultSSLContext,
+                  timeout = -1, userAgent = defUserAgent): string =
   ## | POSTs ``body`` to ``url`` and returns the response's body as a string
   ## | Raises exceptions for the status codes ``4xx`` and ``5xx``
-  var r = post(url, extraHeaders, body)
+  ## | Extra headers can be specified and must be separated by ``\c\L``.
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
+  var r = post(url, extraHeaders, body, maxRedirects, sslContext, timeout,
+               userAgent)
   if r.status[0] in {'4','5'}:
     raise newException(EHTTPRequestErr, r.status)
   else:
     return r.body
   
 proc downloadFile*(url: string, outputFilename: string,
-                   sslContext: PSSLContext = defaultSSLContext) =
-  ## Downloads ``url`` and saves it to ``outputFilename``
+                   sslContext: PSSLContext = defaultSSLContext,
+                   timeout = -1, userAgent = defUserAgent) =
+  ## | Downloads ``url`` and saves it to ``outputFilename``
+  ## | An optional timeout can be specified in miliseconds, if reading from the
+  ## server takes longer than specified an ETimeout exception will be raised.
   var f: TFile
   if open(f, outputFilename, fmWrite):
-    f.write(getContent(url, sslContext))
+    f.write(getContent(url, sslContext = sslContext, timeout = timeout,
+            userAgent = userAgent))
     f.close()
   else:
     fileError("Unable to open file")