factor: trim using lists

[factor.git] / basis / http / http.factor

diff --git a/basis/http/http.factor b/basis/http/http.factor
index a2025a4e0d284fbb7c7c324e3ce005ab07734119..a9995ef3c2275f4afdf7f2c6ebced740da5d61bd 100644 (file)
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -1,11 +1,9 @@
 ! Copyright (C) 2003, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators math namespaces make assocs
-sequences splitting sorting sets strings vectors hashtables
-quotations arrays byte-arrays math.parser calendar
-calendar.format present urls fry io io.encodings
-io.encodings.iana io.encodings.binary io.encodings.utf8 io.crlf
-ascii io.encodings.8-bit.latin1 http.parsers base64 mime.types ;
+USING: accessors arrays ascii assocs base64 calendar calendar.format
+calendar.parser combinators hashtables http.parsers io io.crlf
+io.encodings.iana io.encodings.utf8 kernel make math math.parser
+mime.types present sequences sets sorting splitting urls ;
 IN: http
 
 CONSTANT: max-redirects 10
@@ -54,7 +52,7 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
         f swap
         (parse-set-cookie)
         [
-            swap {
+            swapd pick >lower {
                 { "version" [ >>version ] }
                 { "comment" [ >>comment ] }
                 { "expires" [ [ cookie-string>timestamp >>expires ] unless-empty ] }
@@ -63,8 +61,8 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
                 { "path" [ >>path ] }
                 { "httponly" [ drop t >>http-only ] }
                 { "secure" [ drop t >>secure ] }
-                [ <cookie> dup , nip ]
-            } case
+                [ drop rot <cookie> dup , ]
+            } case nip
         ] assoc-each
         drop
     ] { } make ;
@@ -132,13 +130,14 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
     ] { } make "; " join ;
 
 TUPLE: request
-method
-url
-version
-header
-post-data
-cookies
-redirects ;
+    method
+    url
+    proxy-url
+    version
+    header
+    post-data
+    cookies
+    redirects ;
 
 : set-header ( request/response value key -- request/response )
     pick header>> set-at ;
@@ -149,40 +148,54 @@ redirects ;
 : set-basic-auth ( request username password -- request )
     basic-auth "Authorization" set-header ;
 
+: set-proxy-basic-auth ( request username password -- request )
+    basic-auth "Proxy-Authorization" set-header ;
+
 : <request> ( -- request )
     request new
         "1.1" >>version
         <url>
             H{ } clone >>query
         >>url
+        <url> >>proxy-url
         H{ } clone >>header
         V{ } clone >>cookies
-        "close" "connection" set-header
-        "Factor http.client" "user-agent" set-header
+        "close" "Connection" set-header
+        "Factor http.client" "User-Agent" set-header
         max-redirects >>redirects ;
 
 : header ( request/response key -- value )
     swap header>> at ;
 
+! https://github.com/factor/factor/issues/2273
+! https://observatory.mozilla.org/analyze/factorcode.org
+! https://csp-evaluator.withgoogle.com/?csp=https://factorcode.org
+: add-modern-headers ( response -- response )
+    "max-age=63072000; includeSubDomains; preload" "Strict-Transport-Security" set-header
+    "nosniff" "X-Content-Type-Options" set-header
+    "default-src https: 'unsafe-inline'; frame-ancestors 'none'; object-src 'none'" "Content-Security-Policy" set-header
+    "DENY" "X-Frame-Options" set-header
+    "1; mode=block" "X-XSS-Protection" set-header ;
 
 TUPLE: response
-version
-code
-message
-header
-cookies
-content-type
-content-charset
-content-encoding
-body ;
+    version
+    code
+    message
+    header
+    cookies
+    content-type
+    content-charset
+    content-encoding
+    body ;
 
 : <response> ( -- response )
     response new
         "1.1" >>version
         H{ } clone >>header
-        "close" "connection" set-header
-        now timestamp>http-string "date" set-header
-        "Factor http.server" "server" set-header
+        "close" "Connection" set-header
+        now timestamp>http-string "Date" set-header
+        "Factor http.server" "Server" set-header
+        add-modern-headers
         utf8 >>content-encoding
         V{ } clone >>cookies ;
 
@@ -202,10 +215,10 @@ M: response clone
     over cookies>> push ;
 
 TUPLE: raw-response
-version
-code
-message
-body ;
+    version
+    code
+    message
+    body ;
 
 : <raw-response> ( -- response )
     raw-response new
@@ -218,7 +231,7 @@ TUPLE: post-data data params content-type content-encoding ;
         swap >>content-type ;
 
 : parse-content-type-attributes ( string -- attributes )
-    " " split harvest [
+    split-words harvest [
         "=" split1
         "\"" ?head drop "\"" ?tail drop
     ] { } map>assoc ;