#!/usr/bin/env cgi-factor USING: arrays assocs backticks base64 checksums checksums.md5 combinators command-line csv environment io io.backend.unix io.directories io.encodings.utf8 io.files io.streams.string kernel math math.parser memory namespaces prettyprint sequences sequences.generalizations splitting strings urls.encoding xml.syntax xml.writer peg.ebnf ; IN: reply-cgi : posts-root ( -- path ) ! !!! Modify as needed. "resource:www/boards/" ; : parse-cgi ( string -- assoc ) "&" split [ "=" split ] map ; : reply-form ( -- xml ) "QUERY_STRING" os-env parse-cgi [ "board" of ] [ "thread" of ] bi XML> ; : board-master ( -- path ) posts-root "QUERY_STRING" os-env parse-cgi "board" of ".csv" 3append ; : push-master ( assoc new-id timestamp ip -- ) [ rot "thread" of ] dip 4array board-master utf8 [ write-row ] with-file-appender ; : create-reply ( id tst nm topic hsh body img sig th -- ) ! TODO: Only if file already exists! [ 8 narray board-master ".csv" ] dip "#" ".csv" surround replace [ file-exists? ] [ utf8 [ write-row ] with-file-appender ] [ 2drop ] 1if ; : create-op ( id tst nm topic hsh body img sig -- ) 7 narray swap [ prefix ] keep [ board-master ".csv" ] dip "#" ".csv" surround replace [ touch-file ] keep utf8 [ write-row ] with-file-appender ; : save-quotes ( new-id timestamp assoc -- ) nip "reply" of EBNF[=[ space = ( " " | "\n" | "\r" ) reply = ">>" [0-9]+ space => [[ second >string ]] else = (!(reply) .)+ => [[ drop f ]] main = ( reply | else )* ]=] [ ] filter [ drop ] [ swap prefix board-master ".csv" "#replies.csv" replace utf8 [ write-row ] with-file-appender ] if-empty ; ! Completely unused in thread.cgi! : push-thread ( assoc new-id timestamp -- ) rot [ save-quotes ] 3keep { [ "name" of ] [ "topic" of ] [ "hashcode" of [ f ] [ md5 checksum-bytes >base64 >string ] if-empty ] [ "reply" of ] [ "image" of ] [ "signature" of ] [ "thread" of ] } cleave string>number [ number>string create-reply ] [ create-op ] if* ; : push-reply ( assoc -- ) board-master utf8 file-lines ?last [ read-row ] with-string-reader first string>number 1 + number>string ` date +%s ` but-last "REMOTE_ADDR" os-env md5 checksum-bytes >base64 >string [ push-master ] 4keep drop push-thread ; : normalize-cgi ( assoc -- assoc ) [ "+" " " replace url-decode ] assoc-map ; : process-reply ( -- xml ) "CONTENT_LENGTH" os-env string>number [ 0 ] unless* read parse-cgi normalize-cgi push-reply

Post Sent!

XML> ; ! == Script Proper: "Content-type: text/html\r\n\r\n" print os-envs "REQUEST_METHOD" of { { "GET" [ reply-form write-xml ] } { "POST" [ process-reply write-xml ] } [ drop "Invalid Request" print ] } case