diff --git a/server.scm b/server.scm index 2e2851c..edc6720 100644 --- a/server.scm +++ b/server.scm @@ -14,66 +14,35 @@ ;; 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)) +;;( use-modules (gnutls) ) +(use-modules (ice-9 binary-ports) (ice-9 iconv) (rnrs bytevectors)) -(define port 8080) ;; 1965) -(define nom "localhost") (define chaussette (socket PF_INET SOCK_STREAM 0)) -(bind chaussette AF_INET INADDR_ANY 8081) +(bind chaussette AF_INET INADDR_ANY 8082) (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))) + (let (( rep (accept chaussette ))) + (let ((out (car rep)) (in (cdr rep))) + (define text (make-bytevector 1024)) + (define pos #f) + (recvfrom! out text) - ;; 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))) + (set! pos (string-contains (bytevector->string text "UTF-8") + (string #\return #\nl))) - (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) + ;; si ya pas de \cr\nl, buffer trop grand ou mal formaté + (when (not pos) (begin + (display (string-append "59 Bad Request" (string #\return #\nl)) out)) ) - ) - )) - (shutdown out 2) - ) -)) + (unless (not pos) (begin + (display "all ok") + )) + + (shutdown out 2) +))) (close chaussette) (display "Atterissage réussi")