init

6 files changed, 496 insertions, 0 deletions

diff --git a/itter.service b/itter.service
new file mode 100644
index 0000000..40c4b89
--- /dev/null
+++ b/itter.service
@@ -0,0 +1,24 @@
+[Unit]
+Description=54itter
+After=network.target
+StartLimitIntervalSec=60
+StartLimitBurst=4
+
+[Service]
+User=root
+WorkingDirectory=/root
+ExecStart=/root/54itter
+Restart=on-failure
+RestartSec=1
+SuccessExitStatus=3 4
+RestartForceExitStatus=3 4
+
+# Hardening
+ProtectSystem=full
+PrivateTmp=true
+SystemCallArchitectures=native
+MemoryDenyWriteExecute=true
+NoNewPrivileges=true
+
+[Install]
+WantedBy=multi-user.target
diff --git a/main.scm b/main.scm
new file mode 100644
index 0000000..c36e59f
--- /dev/null
+++ b/main.scm
@@ -0,0 +1,292 @@
+(import (chicken format) (srfi-1))
+(import spiffy intarweb uri-common html-parser (chicken port))
+(import (chicken io))
+(import sqlite3)
+(import srfi-69)
+(import (chicken random))
+
+
+;; db open and create
+
+(define db (open-database "/tmp/54itter.db"))
+
+(when (zero? (first-result db "SELECT count(*) FROM sqlite_master WHERE type='table' AND name='posts'"))
+    (execute db "CREATE TABLE posts (
+                    id TEXT PRIMARY KEY,
+                    user_id TEXT,
+                    content TEXT,
+                    created_at DATETIME default current_timestamp,
+                    parent_id TEXT
+                )")
+    (execute db "CREATE TABLE flush_votes (
+                    user_id TEXT PRIMARY KEY,
+                    created_at DATETIME default current_timestamp
+                )")
+    )
+
+(define (create-post user content)
+  (let ([id (pseudo-random-integer 281474976710655)])
+    (execute db "insert into posts (id, user_id, content) values (?, ?, ?)"
+             id user content)))
+
+(define (vote-to-flush user)
+    (execute db "insert or ignore into flush_votes (user_id) values (?)"
+             user))
+(define (unvote user)
+    (execute db "delete from flush_votes where user_id = ?" user))
+
+
+(define (vote-count) (first-result db "SELECT count(*) FROM flush_votes"))
+
+(define (user-has-voted user) (= 1 (first-result db
+                                        "SELECT count(*) FROM flush_votes WHERE user_id = ?"
+                                        user)))
+
+;;
+
+;(define (read-request-string request)
+;  (let* ((p (request-port request))
+;        (len (header-value 'content-length (request-headers request)))
+;        (port (request-port request)))
+;                    (read-u8vector len port)))
+
+(define style (read-string #f
+  (open-input-file "./style.css" #:text)))
+
+(define (top-posts) (map-row list db
+            "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
+                FROM posts p
+                LEFT JOIN posts c ON c.id = p.parent_id
+                WHERE c.parent_id IS NULL
+                GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
+                ORDER BY count(c.id) DESC LIMIT 25"))
+
+
+
+(define (get-post post-id)
+  (first-row db 
+                "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
+                    FROM posts p
+                    LEFT JOIN posts c ON c.id = p.parent_id
+                    WHERE p.id = ?
+                    GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
+                    ORDER BY count(c.id) DESC LIMIT 1"
+                post-id))
+
+(define (get-child-posts post-id)
+    (map-row list db
+            "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
+                FROM posts p
+                LEFT JOIN posts c ON c.id = p.parent_id
+                WHERE c.parent_id IS ?
+                GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
+                ORDER BY count(c.id) DESC LIMIT 25" post-id))
+
+;(define (top-posts) (map-row list db
+;            "SELECT id, user_id, content, created_at
+;                FROM posts
+;                WHERE parent_id IS NULL
+;                ORDER BY created_at DESC LIMIT 25"))
+
+
+(define (id p) (first p))
+(define (user p) (second p))
+(define (content p) (third p))
+(define (created-at p) (fourth p))
+(define (parent-id p) (fifth p))
+(define (children-count p) (sixth p))
+
+(define users (alist->hash-table '(("dan" . "pw"))))
+
+(define apikeys (make-hash-table))
+
+(define (login username password)
+  (let ([apikey (number->string (pseudo-random-integer 340282366920938463463374607431768211455))])
+      (hash-table-set! apikeys apikey username)
+      apikey))
+
+(define (lookup-user apikey) (hash-table-ref/default apikeys apikey #f))
+
+(define (get-current-user)
+  (let* ([headers (request-headers (current-request))]
+         [cookie (header-value 'cookie headers)]
+         [apikey (if cookie (cdr cookie) #f)])
+    (if apikey (lookup-user apikey) #f)))
+
+(define (post p)
+  `(div (@ [class "post"] [id ,(id p)])
+        (p ,(content p))
+        (div [@ (class "author")]
+             (em "- " ,(user p))
+             (span (@ [style "float:right;"])
+                   (a (@ [href ,(string-append "/posts/" (id p))] [style "margin-right:2px;"])
+                      ,(children-count p) " comments")
+                   ,(created-at p)
+                   ))
+        ))
+
+(define new-post-form
+  `(form (@ [class "new-post-form"] [action "/"] [method "POST"])
+  (span 
+      (textarea (@ [id "content"] [name "content"] [value ""] [rows "5"] [cols "50"])))
+  (input (@ [id "submit"] [type "submit"] [value "Post"]))))
+
+(define (page inner) 
+  (with-output-to-string (lambda ()
+    (sxml-display-as-html
+      `(html (head (style ,style))
+             (body
+;               (h1 "Title")
+;               (a (@ [href "/"]) "Back")
+               ,inner
+               ))))))
+
+(define login-form
+  `(form (@ [class "login-form"] [action "/login"] [method "POST"])
+    (div
+  (div (label (@ [for "username"]) "Username:")
+      (input (@ [type "text"] [id "username"] [name "username"] [value ""])))
+  (div (label (@ [for "password"]) "Password:")
+      (input (@ [type "password"] [id "password"] [name "password"] [value ""])))
+  (input (@ [id "submit"] [type "submit"] [value "Submit"])))))
+
+(define (vote-to-flush-prompt)
+  (let ([prompts '("Flush it all away!")]) ; "Drain the swamp!" "Unclog the bog!")])
+    (list-ref prompts (pseudo-random-integer (length prompts)))))
+
+
+(define (get-route-param route param)
+  (let ([pattern (second route)]
+        [path (uri-path (request-uri (current-request)))])
+  (first (find
+           (lambda (x) (equal? (second x) (string-append ":" param)))
+           (zip path pattern)))))
+
+(define (posts-page current-user displayed-posts) (page
+                               `(div
+                                  (em "Even Shitter than Twitter")
+                                  (br)
+                                  ,(if current-user
+                                     (if (user-has-voted current-user)
+                                       '(a (@ [href "/unvote"]) unvote)
+                                       `(a (@ [href "/vote-to-flush"]) ,(vote-to-flush-prompt)))
+                                     '())
+                                  (div "Votes so far: " ,(vote-count))
+                                  (div
+                                    ,(if current-user
+                                       '(a (@ [style "float:right;"] [href "/logout"]) logout)
+                                       '(a (@ [style "float:right;"] [href "/login"]) login))
+                                    (h2 "Posts")
+                                    ,(if current-user new-post-form '())
+                                    ,(if (null? displayed-posts)
+                                       "No posts yet!"
+                                       (map post displayed-posts))
+                                    )
+                                  )))
+
+(define routes
+  `(
+    (GET (/ "unvote") ,(lambda (rt)
+                            (unvote (get-current-user))
+                           (send-response
+                             headers: `((location "/"))
+                             status: 'see-other
+                             )))
+    (GET (/ "vote-to-flush") ,(lambda (rt)
+                            (let ([user (get-current-user)]) (when user (vote-to-flush user)))
+                            (send-response
+                              headers: `((location "/"))
+                              status: 'see-other
+                              )))
+    (GET (/ "login") ,(lambda (rt) (send-response
+                               headers: '((content-type text/html))
+                               status: 'ok
+                               body: (page `(div
+                                              (a (@ [style "float:right;"] [href "/"]) back)
+                                              (h2 "Login")
+                                              ,login-form)))))
+    (POST (/ "login") ,(lambda (rt)
+                         (let* ([form-data (read-urlencoded-request-data (current-request))]
+                                [username (cdr (assv 'username form-data))]
+                                [password (cdr (assv 'password form-data))]
+                                [apikey (login username password)])
+                           (send-response
+                             headers: `((location "/")
+                                        (set-cookie
+                                          #(("apikey" . ,apikey) ())))
+                             status: 'see-other))))
+    (GET (/ "logout") ,(lambda (rt)
+                           (send-response
+                             headers: `((location "/")
+                                        (set-cookie
+                                          #(("apikey" . "") ()))) ; should also wipe server-side keys
+                             status: 'see-other
+                             )))
+    (POST (/ "") ,(lambda (rt)
+                    (let* ([form-data (read-urlencoded-request-data (current-request))]
+                           [content (cdr (assv 'content form-data))]
+                           [user (get-current-user)]
+                           [success? (if user (create-post user content) #f)])
+                        (send-response
+                               headers: '((location "/"))
+                               status: 'see-other
+                               ))))
+    (GET (/ "") ,(lambda (rt) 
+                   (let ([current-user (get-current-user)]
+                         [displayed-posts (top-posts)])
+                     (send-response
+                       headers: '((content-type text/html))
+                       status: 'ok
+                       body: (posts-page current-user displayed-posts)))))
+
+
+
+(GET (/ "posts" ":id") ,(lambda (rt) 
+                   (let* ([current-user (get-current-user)]
+                         [post-id (get-route-param rt "id")]
+                         [post (get-post post-id)]
+                         [comments (get-child-posts post-id)]
+                         [displayed-posts (cons post comments)])
+                     (send-response
+                       headers: '((content-type text/html))
+                       status: 'ok
+                       body: (posts-page current-user displayed-posts)))))
+
+(GET (/ "posts") ,(lambda (rt)
+                           (send-response
+                             headers: `((location "/"))
+                             status: 'see-other
+                             )))
+
+    ))
+
+(define (route-patterns-match? req pat)
+  (and (= (length req) (length pat))
+       (every
+         (lambda (xy)
+           (let ([x (first xy)] [y (second xy)])
+             (or (equal? x y)
+                 (and (string? y) (< 0 (string-length y))
+                      (equal? #\: (string-ref y 0))))))
+         (zip req pat))))
+
+(define (find-route uri method)
+  (find
+           (lambda (r) (and
+                         (equal?
+                           method
+                           (first r))
+                         (route-patterns-match?
+                           (uri-path uri)
+                           (second r))))
+           routes))
+ 
+(define (handle-greeting continue)
+  (let* ((uri (request-uri (current-request)))
+         (method (request-method (current-request)))
+         (route (find-route uri method))
+         (handler (third route)))
+    (handler route)))
+
+(vhost-map `(("localhost" . ,handle-greeting)))
+(start-server port: 7080)
diff --git a/makefile b/makefile
new file mode 100644
index 0000000..af9f79d
--- /dev/null
+++ b/makefile
@@ -0,0 +1,2 @@
+build: ./main.scm
+	chicken-csc ./main.scm
diff --git a/nginx.conf b/nginx.conf
new file mode 100644
index 0000000..3f682a0
--- /dev/null
+++ b/nginx.conf
@@ -0,0 +1,15 @@
+upstream itter {
+        server localhost:7080;
+}
+
+server {
+        listen 443 ssl;
+        server_name 54itter.dotemgo.com;
+
+        ssl_certificate     /root/dotemgo.com.pem.crt;
+        ssl_certificate_key /root/dotemgo.com.pem.key;
+
+        location / {
+                proxy_pass http://itter;
+        }
+}
diff --git a/refresh.sh b/refresh.sh
new file mode 100755
index 0000000..c48c834
--- /dev/null
+++ b/refresh.sh
@@ -0,0 +1,28 @@
+#!/usr/bin/env sh
+
+CMD="$1"
+FILE="$2"
+#LOG="$(mktemp /tmp/${CMD}log.XXXXXX)"
+
+getChangeTime () {
+    stat -c '%Y' "$FILE"
+}
+
+start () {
+    $CMD $FILE & #2>>$LOG 
+    PSID=$!
+    CHANGETIME="$(getChangeTime)"
+    echo "Started $CMD $FILE at $(TZ=UTC date)"
+}
+
+start
+
+while true; do
+    NEWCHANGETIME="$(getChangeTime)"
+    if [ $NEWCHANGETIME -ne $CHANGETIME ]; then
+        echo "File has changed!"
+        kill $PSID
+        start
+    fi;
+    sleep 1
+done;
diff --git a/style.css b/style.css
new file mode 100644
index 0000000..d674cb7
--- /dev/null
+++ b/style.css
@@ -0,0 +1,135 @@
+html {
+  font-size: 100%;
+}
+
+body {
+  color: black;
+  font-family: Lato, FreeSans, Roboto, Helvetica, Sans-Serif;
+  font-size: 14pt;
+  line-height: 1.6;
+}
+
+table {
+  width: 100%;
+  min-width:100%;
+  max-width:100%;
+}
+
+
+h1, h2, h3, h4 {
+  text-align: left;
+  color: black;
+  font-weight: normal;
+}
+
+h1, h2, h3 {
+  font-weight: bold;
+  margin-bottom:0.5em;
+}
+
+h3, h4, h5, h6 {
+  margin-bottom:0.4em;
+}
+
+/* main 010c5b
+analogous 24015b, 01395b
+*/
+
+h1 {
+  font-size: 28pt;
+  color: #010c5b;
+}
+
+h2 {
+  font-size: 17pt;
+  color: #01395b;
+}
+
+a {
+  color: #010c5b;
+}
+
+h3 {
+  font-size: 16pt;
+}
+
+h4 {
+  font-size: 15pt;
+}
+
+h5 {
+  font-size: 14pt;
+}
+
+h6 {
+  font-size: 10pt;
+  line-height: 1;
+}
+
+ul, ol {
+/*  font-size: 10pt;*/
+/*  line-height: 1.3; */
+}
+
+figcaption {
+  font-style: italic;
+  font-size: 9pt;
+}
+
+table {
+  font-family: arial, sans-serif;
+  border-collapse: collapse;
+  min-width: 60%;
+}
+
+td, th {
+  border: 1px solid #dddddd;
+  text-align: left;
+  padding: 8px;
+}
+
+tr:nth-child(even) {
+  background-color: #dddddd;
+}
+
+.post {
+  border-style: solid;
+  padding: 1em;
+  margin-top: 2px;
+}
+
+.author {
+  font-size: 12pt;
+}
+
+.new-post-form {
+  
+}
+
+.new-post-form #content {
+    width: 100%;
+}
+
+#submit {
+    border: 0;
+    line-height: 2.5;
+    padding: 0 20px;
+    font-size: 1rem;
+    text-align: center;
+    color: #fff;
+    text-shadow: 1px 1px 1px #000;
+    border-radius: 10px;
+    background-color: rgba(0, 0, 220, 1);
+    background-image: linear-gradient(to top left, rgba(0, 0, 0, 0.2), rgba(0, 0, 0, 0.2) 30%, rgba(0, 0, 0, 0));
+    box-shadow: inset 2px 2px 3px rgba(255, 255, 255, 0.6), inset -2px -2px 3px rgba(0, 0, 0, 0.6);
+    margin-top:2px;
+    cursor: pointer;
+}
+
+#submit:hover {
+    background-color: rgba(0, 0, 220, 1);
+}
+
+#submit:active {
+    box-shadow: inset -2px -2px 3px rgba(255, 255, 255, 0.6), inset 2px 2px 3px rgba(0, 0, 0, 0.6);
+}