178 lines
7.4 KiB
Scheme
178 lines
7.4 KiB
Scheme
;; Copyright (C) 2023 Skylar Widulski <cobra@vern.cc>
|
|
;;
|
|
;; This file is part of MeMe
|
|
;;
|
|
;; MeMe is free software: you can redistribute it and/or modify it under the
|
|
;; terms of the GNU Affero 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 Affero General Public License
|
|
;; for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU Affero General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
(define-module (meme)
|
|
#:use-module (meme templates)
|
|
#:use-module (meme pages)
|
|
#:use-module (meme scraping)
|
|
#:use-module (web server)
|
|
#:use-module (web uri)
|
|
#:use-module (web request)
|
|
#:use-module (web http)
|
|
#:use-module (ice-9 suspendable-ports)
|
|
#:use-module (ice-9 textual-ports)
|
|
#:use-module (ice-9 binary-ports))
|
|
|
|
(install-suspendable-ports!)
|
|
|
|
(define (handler request request-body)
|
|
(let ((uri (request-uri request))
|
|
(path (uri-path (request-uri request)))
|
|
(path-components
|
|
(split-and-decode-uri-path
|
|
(uri-path
|
|
(request-uri request)))))
|
|
|
|
(display (string-append
|
|
(strftime "%c" (localtime (current-time)))
|
|
": " (uri->string uri)))
|
|
(cond
|
|
((equal? path "/style.css")
|
|
(display ";\tHandler: internal") (newline)
|
|
(values '((content-type . (text/css)))
|
|
(call-with-input-file "static/style.css" get-string-all)))
|
|
((equal? path "/favicon.png")
|
|
(display ";\tHandler: internal") (newline)
|
|
(values '((content-type . (image/png)))
|
|
(call-with-input-file "static/logo.png" get-bytevector-all)))
|
|
((equal? path "/proxy")
|
|
(proxy-page (uri-query uri)))
|
|
((or (equal? path "/")
|
|
(equal? (car path-components) "page"))
|
|
(newsfeed-page path))
|
|
((or
|
|
(equal? (car (last-pair path-components)) "photos")
|
|
(and (>= (length path-components) 3)
|
|
(equal? (list-ref
|
|
path-components
|
|
(- (length path-components) 3))
|
|
"photos")
|
|
(equal? (list-ref
|
|
path-components
|
|
(- (length path-components) 2))))
|
|
(and (>= (length path-components) 2)
|
|
(equal? (list-ref
|
|
path-components
|
|
(- (length path-components) 2))
|
|
"photos")
|
|
(not (> (string-count
|
|
(car (last-pair path-components))
|
|
char-set:digit 0 1)
|
|
0))))
|
|
(photos-page path))
|
|
((and (>= (length path-components) 2)
|
|
(equal? (list-ref
|
|
path-components
|
|
(- (length path-components) 2))
|
|
"photos")
|
|
(> (string-count
|
|
(car (last-pair path-components))
|
|
char-set:digit 0 1)
|
|
0))
|
|
(photo-page path))
|
|
; ((or
|
|
; (equal? (car (last-pair path-components)) "videos")
|
|
; (and (>= (length path-components) 3)
|
|
; (equal? (list-ref
|
|
; path-components
|
|
; (- (length path-components) 3))
|
|
; "videos")
|
|
; (equal? (list-ref
|
|
; path-components
|
|
; (- (length path-components) 2))))
|
|
; (and (>= (length path-components) 2)
|
|
; (equal? (list-ref
|
|
; path-components
|
|
; (- (length path-components) 2))
|
|
; "videos")
|
|
; (not (> (string-count
|
|
; (car (last-pair path-components))
|
|
; char-set:digit 0 1)
|
|
; 0))))
|
|
; (videos-page path))
|
|
((and (equal? (car path-components) "memes")
|
|
(or
|
|
(or (equal? (car (last-pair path-components)) "children")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"children")))
|
|
(or (equal? (car (last-pair path-components)) "submissions")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"submissions")))
|
|
(or (equal? (car (last-pair path-components)) "researching")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"researching")))
|
|
(or (equal? (car (last-pair path-components)) "newsworthy")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"newsworthy")))
|
|
(or (equal? (car (last-pair path-components)) "popular")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"popular")))
|
|
(or (equal? (car (last-pair path-components)) "deadpool")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"deadpool")))
|
|
(or (equal? (car (last-pair path-components)) "all")
|
|
(and
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 2))
|
|
"page")
|
|
(equal? (list-ref path-components
|
|
(- (length path-components) 3))
|
|
"all")))))
|
|
(meme-list-page path))
|
|
((equal? (car path-components) "memes")
|
|
(meme-page path))
|
|
(else (error-page 404)))))
|
|
|
|
(define sock (socket PF_INET SOCK_STREAM 0))
|
|
(let ((port (if (getenv "PORT")
|
|
(string->number (getenv "PORT"))
|
|
8003)))
|
|
(bind sock AF_INET INADDR_ANY port)
|
|
(fcntl sock F_SETFL (logior O_NONBLOCK
|
|
(fcntl sock F_GETFL)))
|
|
(run-server handler 'http `(#:socket ,sock)))
|