fork(1) download 
  1. (use srfi-1 srfi-13 srfi-18 tcp)
  2.  
  3. (define sleep thread-sleep!)
  4.  
  5. (define (chop lst key)
  6.  (define (accum-aux l)
  7.   (if (every eq? (cdr l) key)
  8.    ((lambda (r) (set-cdr! l '()) r)
  9.     (list-tail (cdr l) (length key)))
  10.    (accum-aux (cdr l))))
  11.  (if (every eq? lst key)
  12.   (list-tail lst (length key))
  13.   (accum-aux lst)))
  14.  
  15. (define (tokenise s token)
  16.  (define (t-aux lst key)
  17.   (if (null? lst) '()
  18.    ((lambda (x)
  19.      (cons (list->string lst) (t-aux x key)))
  20.     (chop lst key))))
  21.  (t-aux (string->list s) (string->list token)))
  22.  
  23. (define (send host port message)
  24.  (apply
  25.   (lambda (reader writer)
  26.    (display message writer)
  27.    (string-unfold eof-object? values
  28.     (lambda (x) (read-char reader))
  29.     (read-char reader)))
  30.   (call-with-values
  31.    (lambda () (tcp-connect host 80)) list)))
  32.  
  33. ; -----------------------------------------------------------------------------
  34.  
  35. (define (post thread-id name email comment)
  36.  (send "dis.4chan.org" 80
  37.   ((lambda (body)
  38.     (string-append
  39.      "POST /post HTTP/1.1\r\n"
  40.      "Host: dis.4chan.org\r\n"
  41.      "Connection: close\r\n"
  42.      "Content-Type: application/x-www-form-urlencoded\r\n"
  43.      "Content-Length: " (number->string (string-length body)) "\r\n\r\n"
  44.      body))
  45.    (string-append "bbs=prog&"
  46.     "id=" thread-id "&"
  47.     "shiichan=proper2&"
  48.     "kotehan=" name "&"
  49.     "meiru=" email "&"
  50.     "com=" comment "&"
  51.     "email=%27"))))
  52.  
  53. (define (get page)
  54.  (send "dis.4chan.org" 80
  55.   (string-append
  56.    "GET " page " HTTP/1.1\r\n"
  57.    "Host: dis.4chan.org\r\n"
  58.    "Connection: close\r\n\r\n")))
  59.  
  60. (define (electro-shocker! thread-list)
  61.  (post (fourth (list-ref thread-list (random (length thread-list))))
  62.   "James+Gosling" "" "GAWWWWWWWWZMACSSSSSS+FLABBERGASTS+MY+AUDIENCE")
  63.  (sleep 5)
  64.  (electro-shocker! thread-list))
  65.  
  66. (electro-shocker!
  67.  (filter-map
  68.   (lambda (x)
  69.    ((lambda (tokens)
  70.      (if (= (length tokens) 7) tokens #f))
  71.     (tokenise x "<>")))
  72.   (tokenise (get "/prog/subject.txt") "\n")))
Not running #stdin #stdout 0s 0KB
comments (?)
stdin 
Standard input is empty
stdout 
Standard output is empty
https://ideone.com/VA3Mpc
language:
Scheme (guile 2.2.4)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!