feat: send file and manage some errors
Redirect if url has no path Error if file not found Send file index.gmi if path is / Serve all gemini files in www/
This commit is contained in:
parent
d8e1e49e58
commit
1910a46006
1 changed files with 46 additions and 12 deletions
56
server.scm
56
server.scm
|
@ -14,32 +14,66 @@
|
||||||
;; You should have received a copy of the GNU General Public License along with
|
;; You should have received a copy of the GNU General Public License along with
|
||||||
;; this program. If not, see <https://www.gnu.org/licenses/>.
|
;; this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
;;( use-modules (gnutls) )
|
;;(use-modules (gnutls))
|
||||||
(use-modules (ice-9 binary-ports) (ice-9 iconv) (rnrs bytevectors))
|
(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))
|
(define chaussette (socket PF_INET SOCK_STREAM 0))
|
||||||
(bind chaussette AF_INET INADDR_ANY 8081)
|
(bind chaussette AF_INET INADDR_ANY 8081)
|
||||||
(listen chaussette 1)
|
(listen chaussette 1)
|
||||||
(display "Chaussette en place")
|
(display "Chaussette en place")
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
(while #t
|
(while #t
|
||||||
(let (( rep (accept chaussette )))
|
(let (( rep (accept chaussette )))
|
||||||
(let ((out (car rep)) (in (cdr rep)))
|
(let ((out (car rep)) (in (cdr rep)))
|
||||||
(define text (make-bytevector 1024))
|
(define byte-buff (make-bytevector 1024))
|
||||||
(define pos #f)
|
(define pos #f)
|
||||||
(recvfrom! out text)
|
(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)))
|
||||||
|
|
||||||
(set! pos (string-contains (bytevector->string text "UTF-8")
|
;; si ya pas de \cr\nl, buffer trop grand ou url mal formatée
|
||||||
(string #\return #\nl)))
|
|
||||||
|
|
||||||
;; si ya pas de \cr\nl, buffer trop grand ou mal formaté
|
|
||||||
(if (not pos)
|
(if (not pos)
|
||||||
(display (string-append "59 Bad Request" (string #\return #\nl)) out)
|
;; TODO message about error
|
||||||
(display "all ok")
|
(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)
|
(shutdown out 2)
|
||||||
)))
|
)
|
||||||
|
))
|
||||||
|
|
||||||
(close chaussette)
|
(close chaussette)
|
||||||
(display "Atterissage réussi")
|
(display "Atterissage réussi")
|
||||||
|
|
Loading…
Reference in a new issue