...
 
Commits (16)
  • amirouche's avatar
    cosmit · 7e2bcb49
    amirouche authored
    7e2bcb49
  • amirouche's avatar
    typofix · 57b30c27
    amirouche authored
    57b30c27
  • amirouche's avatar
    typofix · 5b777d43
    amirouche authored
    5b777d43
  • amirouche's avatar
    26160b05
  • amirouche's avatar
    argon2: update to 0~20161029-1 (ubuntu 17.10) · 54d99366
    amirouche authored
    - add %argon-type-argon2-d, %argon-type-argon2-i, %argon-type-argon2-id private variables
    - encoded-length: add argon-type parameter
    - hash-secret: change urandom parameter to be the relevant variable
    - hash-secret: pass %argon-type-argon2-i as argon-type argument to encoded-length
    54d99366
  • amirouche's avatar
    .dir-locals.el: add template · 394b91d8
    amirouche authored
    394b91d8
  • amirouche's avatar
    html: add sxml/maybe · d3b37dd0
    amirouche authored
    d3b37dd0
  • amirouche's avatar
    .gitignore: add src/wt/ · 3dc9b3ef
    amirouche authored
    3dc9b3ef
  • amirouche's avatar
    style: move make-class · d543c835
    amirouche authored
    d543c835
  • amirouche's avatar
    doc++ · 4032aadd
    amirouche authored
    4032aadd
  • amirouche's avatar
    cosmit · d0117e8d
    amirouche authored
    d0117e8d
  • amirouche's avatar
    cosmit · 7600ba94
    amirouche authored
    7600ba94
  • amirouche's avatar
    css: rename form-item to form-field · 3153de2b
    amirouche authored
    3153de2b
  • amirouche's avatar
    helpers: rename render-html to sxml->response · 0fdb05b8
    amirouche authored
    0fdb05b8
  • amirouche's avatar
    helpers: add cookies helpers. · cbe0db05
    amirouche authored
    - Add a #:cookies key parameter to 'redirect' that allows to set
      cookies. This is done in 'redirect' because it seems to me that
      settings cookies is only useful after a form a successful POST
      request and POST requests must always be followed by a redirect to
      avoid buggy request replay (via page refresh).
    
    - Add 'request-cookies' public procedure.
    cbe0db05
  • amirouche's avatar
    complete sign up and sign in paths · a2599b01
    amirouche authored
    - app: Add module with a 'app' record, to store application wide
      variables. It has only a pepper (aka. 'secret' in some other
      frameworks) field right.
    
    - web: import 'make-hash', 'string-sign' and 'string-verify' which allow to
      sign strings. It's used to validated cookie values.
    
    - web: add 'log-debug' and 'log-info' procedures
    
    - web: add 'rm', 'set', 'ref', 'set*' and 'ref*' procedures to help with
      association lists that have strings as keys.
    
    - web: replace render-html with sxml->response
    
    - web: index: display a welcome message if an user is logged in
    
    - web: create 'form/input' and 'form/submit' for consistent forms with
      label, value and error handling.
    
    - web: add query-user-by-username, query-user-by-uid and request-user
    
    - web: signin and signup: refactor to make use for 'form/input' and
      'form/submit', shallow and deep input validation (in particular add
      'strong?' password predicate), set 'token' cookie when the user sign in.
    a2599b01
...@@ -22,4 +22,5 @@ ...@@ -22,4 +22,5 @@
(put 'with-cnx 'scheme-indent-function 1) (put 'with-cnx 'scheme-indent-function 1)
;; others ;; others
(put 'match 'scheme-indent-function 1) (put 'match 'scheme-indent-function 1)
(put 'template 'scheme-indent-function 1)
))))) )))))
(define-module (app))
(use-modules ((srfi srfi-9)))
(define-record-type <app>
(make-app pepper)
app?
(pepper app-pepper))
(export make-app)
(export app-pepper)
...@@ -17,6 +17,8 @@ ...@@ -17,6 +17,8 @@
;; ;;
;; https://martinfowler.com/articles/web-security-basics.html ;; https://martinfowler.com/articles/web-security-basics.html
;; ;;
;; argon2 version 0~20161029-1
;;
(define-module (argon2)) (define-module (argon2))
(use-modules (ice-9 binary-ports)) (use-modules (ice-9 binary-ports))
...@@ -46,7 +48,11 @@ ...@@ -46,7 +48,11 @@
(let ((function (dynamic-func function-name shared-object))) (let ((function (dynamic-func function-name shared-object)))
(pointer->procedure return-value function arguments))))) (pointer->procedure return-value function arguments)))))
(define argon2 (dynamic-link* "/usr/lib/x86_64-linux-gnu/libargon2.so")) (define argon2 (dynamic-link* "/usr/lib/x86_64-linux-gnu/libargon2.so")) ;; TODO
(define %argon-type-argon2-d 0)
(define %argon-type-argon2-i 1)
(define %argon-type-argon2-id 2)
(define error-message (define error-message
(let ((func (argon2 '* (let ((func (argon2 '*
...@@ -62,9 +68,10 @@ ...@@ -62,9 +68,10 @@
uint32 uint32
uint32 uint32
uint32 uint32
uint32))) uint32
(lambda (time-cost memory-cost parallelism salt-length hash-length) int)))
(func time-cost memory-cost parallelism salt-length hash-length)))) (lambda (time-cost memory-cost parallelism salt-length hash-length argon-type)
(func time-cost memory-cost parallelism salt-length hash-length argon-type))))
(define argon2i-hash-encode (define argon2i-hash-encode
(let ((func (argon2 int (let ((func (argon2 int
...@@ -98,16 +105,17 @@ ...@@ -98,16 +105,17 @@
(define-public (hash-secret password pepper) (define-public (hash-secret password pepper)
"Hash PASSWORD and PEPPER" "Hash PASSWORD and PEPPER"
(let ((password* (string-append password pepper))) (let ((password* (string-append password pepper)))
(let ((time-cost 2) ;; default values from argon2_cffi (let* ((time-cost 2) ;; default values from argon2_cffi
(memory-cost 512) (memory-cost 512)
(parallelism 2) (parallelism 2)
(length 16) (length 16)
(salt (urandom 16))) (salt (urandom length)))
(let ((total (encoded-length time-cost (let ((total (encoded-length time-cost
memory-cost memory-cost
parallelism parallelism
length length
length))) length
%argon-type-argon2-i)))
(utf8->string (argon2i-hash-encode time-cost (utf8->string (argon2i-hash-encode time-cost
memory-cost memory-cost
parallelism parallelism
...@@ -124,10 +132,15 @@ ...@@ -124,10 +132,15 @@
(define-public (verify encoded password pepper) (define-public (verify encoded password pepper)
"Verify that ENCODED is really associated with PASSWORD and PEPPER" "Verify that ENCODED is really associated with PASSWORD and PEPPER"
(let ((password* (string->utf8 (string-append password pepper))) (let ((password* (string->utf8 (string-append password pepper))))
(let ((out (argon2i-verify (bytevector->pointer (string->utf8 encoded)) (let ((out (argon2i-verify (bytevector->pointer (string->utf8 encoded))
(bytevector->pointer password*) (bytevector->pointer password*)
(bytevector-length password*)))) (bytevector-length password*))))
(if (zero? out) (if (zero? out)
#t #t
(throw 'argon2 (error-message out)))))) (throw 'argon2 (error-message out))))))
(define-public (verify* encoded password pepper)
(catch 'argon2
(lambda () (verify encoded password pepper))
(const #f)))
...@@ -120,24 +120,24 @@ form p { ...@@ -120,24 +120,24 @@ form p {
margin: 0px; margin: 0px;
} }
form > div.form-item.error { form > div.form-field.error {
color: rgb(200, 10, 10); color: rgb(200, 10, 10);
} }
form > div.form-item > p:first-child { form > div.form-field > p:first-child {
display: flex; display: flex;
padding: 10px 50px; padding: 10px 50px;
margin-bottom: 0px; margin-bottom: 0px;
padding-bottom: 0px; padding-bottom: 0px;
} }
form > div.form-item > p:first-child > label { form > div.form-field > p:first-child > label {
margin-right: 10px; margin-right: 10px;
min-width: 200px; min-width: 200px;
text-align: right; text-align: right;
} }
form > div.form-item > p.error { form > div.form-field > p.error {
padding: 5px 50px; padding: 5px 50px;
margin: 0px; margin: 0px;
font-size: 0.7em; font-size: 0.7em;
...@@ -160,7 +160,7 @@ form .error input[type="password"] { ...@@ -160,7 +160,7 @@ form .error input[type="password"] {
border: 1px solid rgb(200, 10, 10); border: 1px solid rgb(200, 10, 10);
} }
form > div.form-item > p.form-control { form > div.form-field > p.form-control {
display: flex; display: flex;
justify-content: right; justify-content: right;
} }
...@@ -175,7 +175,6 @@ form > div.form-item > p.form-control { ...@@ -175,7 +175,6 @@ form > div.form-item > p.form-control {
#query { #query {
border: 0px solid black; border: 0px solid black;
text-align: center;
flex-grow: 2; flex-grow: 2;
box-sizing: border-box; box-sizing: border-box;
font-family: hack, mono, monospace; font-family: hack, mono, monospace;
......
This diff is collapsed.
...@@ -15,12 +15,12 @@ ...@@ -15,12 +15,12 @@
(define-module (web helpers)) (define-module (web helpers))
;; stdlib ;; stdlib
(use-modules (web request)) (use-modules ((web request)))
(use-modules (web response)) (use-modules ((web response)))
(use-modules (web uri)) (use-modules ((web uri)))
;; local ;; local
(use-modules (web html)) (use-modules ((web html)))
;;; helpers ;;; helpers
...@@ -30,7 +30,8 @@ ...@@ -30,7 +30,8 @@
example: \"/foo/bar\" yields '(\"foo\" \"bar\")." example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(split-and-decode-uri-path (uri-path (request-uri request)))) (split-and-decode-uri-path (uri-path (request-uri request))))
(define-public (render-html sxml)
(define-public (sxml->response sxml)
(values '((content-type . (text/html))) (values '((content-type . (text/html)))
(lambda (port) (lambda (port)
(sxml->html sxml port)))) (sxml->html sxml port))))
...@@ -43,8 +44,40 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")." ...@@ -43,8 +44,40 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(values (build-response #:code 404) (values (build-response #:code 404)
(string-append "Resource not found: " uri))) (string-append "Resource not found: " uri)))
(define-public (redirect uri) (define (make-set-cookie-header pair) ;; XXX: https://mdn.io/Set-Cookie,
(values (build-response #:code 303 #:headers `((Location . ,uri))) "")) (let ((key (car pair))
(value (cdr pair)))
;; The cookie will have the lifetime of a session cookie.
`(Set-Cookie . ,(string-append (symbol->string key)
"= "
value
"; HttpOnly"
"; SameSite=Strict"))))
(define (alist->set-cookie-headers alist)
(let loop ((alist alist)
(out '()))
(if (null? alist)
out
(loop (cdr alist) (cons (make-set-cookie-header (car alist)) out)))))
(define-public redirect
(lambda* (uri #:key cookies)
(if cookies
(let ((headers (append `((Location . ,uri))
(alist->set-cookie-headers cookies))))
(values (build-response #:code 303 #:headers headers) ""))
(values (build-response #:code 303 #:headers `((Location . ,uri))) ""))))
(define-public (error) (define-public (error)
(values (build-response #:code 500))) (values (build-response #:code 500)))
(define (%make-cookie item)
(let ((item* (string-split item #\=)))
(cons (string->symbol (car item*)) (cadr item*))))
(define-public (request-cookies request)
(let ((headers (request-headers request)))
(and=> (assq-ref headers 'cookie)
(lambda (cookie)
(map %make-cookie (map string-trim (string-split cookie #\;)))))))
...@@ -131,3 +131,8 @@ list ATTRS and the child nodes in BODY." ...@@ -131,3 +131,8 @@ list ATTRS and the child nodes in BODY."
(obj (object->escaped-html obj port)))) (obj (object->escaped-html obj port))))
(export sxml->html) (export sxml->html)
(define-syntax-rule (sxml/maybe value)
(if value value '()))
(export sxml/maybe)
...@@ -17,6 +17,7 @@ ...@@ -17,6 +17,7 @@
(_ (->string value)))) (_ (->string value))))
(define-public (make-style alist) (define-public (make-style alist)
"Create style from an ALIST"
(let loop ((alist alist) (let loop ((alist alist)
(out "")) (out ""))
(if (null? alist) (if (null? alist)
...@@ -27,3 +28,13 @@ ...@@ -27,3 +28,13 @@
(symbol->string (caar alist)) (symbol->string (caar alist))
": " ": "
(make-value (cdar alist))))))) (make-value (cdar alist)))))))
(define-public (make-class alist)
"Create html class attribute with an ALIST"
(let loop ((alist alist)
(out ""))
(if (null? alist)
out
(if (cdar alist)
(loop (cdr alist) (string-append (caar alist) " " out))
(loop (cdr alist) out)))))