Paste: reply.cgi

#!/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
   <html> <head>
      <link rel="stylesheet" href="/static/style.css"/>
   </head> 
   <form method="post" id="reply" action="">
      <label> Topic:    <input name="topic" placeholder="(Optional)"/></label>
      <label> Name:     <input name="name" placeholder="Anonymous" /></label>
      <label> Hashcode: <input name="hashcode" /></label>
      <button> Send! </button>
      <div style="display:flex;justify-content:center;">
           <textarea name="reply" required="true"
            rows="22" cols="80"></textarea>
      </div>
      <label> Image:     <input name="image" 
                         placeholder="https://example.com/hotlink.png" 
                                size="30"/></label>
      <label> Signature: <input name="signature" /></label>
      <input type="hidden"  name="board" value=<-> />
      <input type="hidden" name="thread" value=<-> />
   </form> </html> 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
   <XML <html><head>
      <meta http-equiv="refresh" content="1" />
      <link rel="stylesheet" href="/static/style.css"/>
   </head> 
        <body><div id="reply-sent"><p> Post Sent! </p></div></body>
   </html> 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