;; Basic Gemini server
;; 
;; Copyright (C) 2022 rick G. <rick@gnous.eu>
;; 
;; This program is free software: you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any later
;; version.
;; 
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License along with
;; this program. If not, see <https://www.gnu.org/licenses/>.

;;(use-modules (gnutls))
(use-modules (ice-9 binary-ports) (ice-9 iconv) (rnrs bytevectors) (web uri) (ice-9 textual-ports))

(define port 8080) ;; 1965)
(define nom "localhost")
(define chaussette (socket PF_INET SOCK_STREAM 0))
(bind chaussette AF_INET INADDR_ANY 8081)
(listen chaussette 1)
(display "Chaussette en place")
(newline)

(while #t 
    (let (( rep (accept chaussette )))
    (let ((out (car rep)) (in (cdr rep)))
    (define byte-buff (make-bytevector 1024))
    (define pos #f)
    (define url "")
    (recvfrom! out byte-buff)
    (set! url (bytevector->string byte-buff "UTF-8"))
    ;; position du CRLF dans l'url demandé
    (set! pos (string-contains url (string #\return #\nl)))

    ;; si ya pas de \cr\nl, buffer trop grand ou url mal formatée
    (if (not pos)
        ;; TODO message about error
        (display (string-append "59 Bad Request" (string #\return #\nl)) out))
        ;; on parse l'url
        (begin (let ((url-parse (string->uri (substring url 0 pos))))
        (if (not url-parse)
            (display (string-append "59 Bad Request" (string #\return #\nl)) out))
            (begin
            ;; on vérifie que c'est bien le protocole gemini
            (if (eq? (quote gemini) (uri-scheme url-parse))
                (begin (let ((path (uri-path url-parse)))

                    (if (string=? path "")
                        ;; si ya pas de chemin, on redirige vers / (l'index)
                        (display (string-append "31 gemini://" nom "/" (string #\return #\nl)) out)
                        (begin 
                            (if (string=? path "/") (set! path "/index.gmi"))
                            ;; on rajoute le chemin du dossier contenant les fichiers
                            (set! path (string-append "www" path))
                            ;; si on a accès au fichier, on l'envoie, sinon pas trouvé
                            (if (access? path R_OK)  
                                (display (string-append "20 text/gemini" (string #\return #\nl)
                                    (get-string-all (open-file path "r"))) out)
                                (display (string-append "51 Not Found" (string #\return #\nl)) out)
                            )
                        )
                    )
                ))

                (display (string-append "53 Proxy Request Refused" (string #\return #\nl)) out)
            )
        )
    ))

    (shutdown out 2)
    )
))

(close chaussette)
(display "Atterissage réussi")
(newline)