(use srfi-1 srfi-13 srfi-18 tcp)

(define sleep thread-sleep!)

(define (chop lst key)
 (define (accum-aux l)
  (if (every eq? (cdr l) key)
   ((lambda (r) (set-cdr! l '()) r)
    (list-tail (cdr l) (length key)))
   (accum-aux (cdr l))))
 (if (every eq? lst key)
  (list-tail lst (length key))
  (accum-aux lst)))

(define (tokenise s token)
 (define (t-aux lst key)
  (if (null? lst) '()
   ((lambda (x)
     (cons (list->string lst) (t-aux x key)))
    (chop lst key))))
 (t-aux (string->list s) (string->list token)))

(define (send host port message)
 (apply
  (lambda (reader writer)
   (display message writer)
   (string-unfold eof-object? values
    (lambda (x) (read-char reader))
    (read-char reader)))
  (call-with-values
   (lambda () (tcp-connect host 80)) list)))

; -----------------------------------------------------------------------------

(define (post thread-id name email comment)
 (send "dis.4chan.org" 80
  ((lambda (body)
    (string-append
     "POST /post HTTP/1.1\r\n"
     "Host: dis.4chan.org\r\n"
     "Connection: close\r\n"
     "Content-Type: application/x-www-form-urlencoded\r\n"
     "Content-Length: " (number->string (string-length body)) "\r\n\r\n"
     body))
   (string-append "bbs=prog&"
    "id=" thread-id "&"
    "shiichan=proper2&"
    "kotehan=" name "&"
    "meiru=" email "&"
    "com=" comment "&"
    "email=%27"))))

(define (get page)
 (send "dis.4chan.org" 80
  (string-append
   "GET " page " HTTP/1.1\r\n"
   "Host: dis.4chan.org\r\n"
   "Connection: close\r\n\r\n")))

(define (electro-shocker! thread-list)
 (post (fourth (list-ref thread-list (random (length thread-list))))
  "James+Gosling" "" "GAWWWWWWWWZMACSSSSSS+FLABBERGASTS+MY+AUDIENCE")
 (sleep 5)
 (electro-shocker! thread-list))

(electro-shocker!
 (filter-map
  (lambda (x)
   ((lambda (tokens)
     (if (= (length tokens) 7) tokens #f))
    (tokenise x "<>")))
  (tokenise (get "/prog/subject.txt") "\n")))