(module problem05 ()

(import scheme)
(import (chicken base))
(import (chicken condition))
(import (chicken format))
(import (chicken io))
(import (chicken irregex))
(import (chicken port))
(import (chicken process signal))
(import (chicken string))
(import (chicken time))
(import (srfi 18))
(import (srfi 69))
(import socket)

(define stderr (current-error-port))
(set-buffering-mode! stderr #:line)

(define str string-append)

(define (elog fmt #!rest args)
  (apply fprintf stderr (str "[~s] " fmt) (current-process-milliseconds) args))

(define host "0.0.0.0")
(define port 10000)

(define upstream-host "chat.protohackers.com")
(define upstream-port 16963)

(define backlog 10)
(socket-receive-timeout #f)

(define listener (socket af/inet sock/stream))
(set! (so-reuse-address? listener) #t)
(socket-bind listener (inet-address host port))
(socket-listen listener backlog)

(define boguscoin-address-rx
  (irregex '(: (or bol (look-behind " "))
               (: "7" (** 25 34 alnum))
               (or eol (look-ahead " ")))))

(define boguscoin-dest-address "7YWHMfk9JZe0LM0g1ZauHuiSxhI")

(define (process-line line)
  (irregex-replace/all boguscoin-address-rx line boguscoin-dest-address))

(define (read-until char port)
  (call-with-output-string
   (lambda (out)
     (let loop ()
       (let ((x (peek-char port)))
         (when (not (eof-object? x))
           (display (read-char port) out))
         (when (not (or (eof-object? x) (eqv? x char)))
           (loop)))))))

(define (newline-terminated? string)
  (let ((len (string-length string)))
    (and (> len 0) (eqv? (string-ref string (sub1 len)) #\newline))))

(define (ignore-net-errors thunk)
  (condition-case (thunk)
   (e (exn i/o net) #f)))

(define (handle-upstream client-socket upstream-socket)
  (receive (upstream-in upstream-out) (socket-i/o-ports upstream-socket)
    (receive (client-in client-out) (socket-i/o-ports client-socket)
      (ignore-net-errors
       (lambda ()
         (let loop ()
           (let ((line (read-until #\newline upstream-in)))
             (when (not (eof-object? line))
               (elog "Received upstream line: ~s (~s)\n" line upstream-socket)
               (when (newline-terminated? line)
                 (display (process-line line) client-out)
                 (elog "Wrote upstream line: ~s (~s)\n" line client-socket)
                 (loop))))))))))

(define (handle-client client-socket)
  (set! (so-reuse-address? client-socket) #t)
  (let* ((addrs (address-information upstream-host upstream-port
                                     type: sock/stream))
         (upstream-socket (socket-connect/ai addrs)))
    (set! (so-reuse-address? upstream-socket) #t)
    (elog "Wiring up ~s <-> ~s\n" client-socket upstream-socket)
    (thread-start!
     (make-thread
      (lambda ()
        (handle-upstream client-socket upstream-socket))))
    (receive (client-in client-out) (socket-i/o-ports client-socket)
      (receive (upstream-in upstream-out) (socket-i/o-ports upstream-socket)
        (let loop ()
          (let ((line (read-until #\newline client-in)))
            (when (not (eof-object? line))
              (elog "Received client line: ~s (~s)\n" line client-socket)
              (when (newline-terminated? line)
                (display (process-line line) upstream-out)
                (elog "Wrote client line: ~s (~s)\n" line upstream-socket)
                (loop)))))
        (close-input-port upstream-in)
        (close-output-port upstream-out))
      (close-input-port client-in)
      (close-output-port client-out))))

(let loop ()
  (let ((client-socket (socket-accept listener)))
    (thread-start!
     (make-thread
      (lambda ()
        (handle-client client-socket))))
    (loop)))

(set-signal-handler! signal/int (lambda (_) (socket-close listener) (exit 0)))

)