moontalk/server/eventloop-server-experiment/torcontrol.4th

\ Simple torcontrol interface that only supports closing circuits.
\ We only support the authcookie authentication. We can retrieve the authcookie
\ file location by doing the following:
\
\  telnet localhost 9051
\  PROTOCOLINFO
\
\ The user that this server is running under must have permission to read
\ the tor cookie file. On Debian the user must be added to the debian-tor group.
\
\ TODO: write a proper client for this?
\ TODO: at least check for success responses?
\ TODO: we only support ipv4 for now

require unix/socket.fs

require util.4th
require extensions.4th

512 constant TORCONTROL_SENDBUFFER_SIZE
512 constant TORCONTROL_RECVBUFFER_SIZE
 32 constant TORCONTROL_COOKIE_FILESIZE
 64 constant TORCONTROL_COOKIE_SIZE

           CONFIG_TOR_CONTROL_ADDR  constant TORCONTROL_ADDR
           CONFIG_TOR_CONTROL_PORT  constant TORCONTROL_PORT
CONFIG_TOR_CONTROL_COOKIE_FILEPATH sconstant TORCONTROL_COOKIE_FILEPATH

create torcontrol-cookie TORCONTROL_COOKIE_SIZE allot
create torcontrol-sendbuffer TORCONTROL_SENDBUFFER_SIZE allot
create torcontrol-recvbuffer TORCONTROL_RECVBUFFER_SIZE allot

CONFIG_TOR_CONTROL_AUTHMETHOD TOR_CONTROL_AUTHMETHOD_COOKIE = [IF]
  variable (file)
  : (zero-prefix) ( c -- str )
    16 < IF s" 0" ELSE 0 0 THEN ;
  : (byte>hex) ( c -- str )
    hex to-string decimal ;
  : (binarycookie>hexcookie) ( binary-str -- )
    s" " pad place
    over + swap DO
      I c@ dup
      (zero-prefix) pad +place
      (byte>hex) pad +place
    LOOP
    pad count torcontrol-cookie swap move ;
  : torcontrol-load-cookie ( str -- )
    r/o open-file throw (file) !
    torcontrol-recvbuffer TORCONTROL_COOKIE_FILESIZE (file) @ read-file abort" torcontrol read failed"
    TORCONTROL_COOKIE_FILESIZE <> abort" torcontrol read failed."
    torcontrol-recvbuffer TORCONTROL_COOKIE_FILESIZE (binarycookie>hexcookie)
    (file) @ close-file abort" torcontrol close-file failed" ;
    
    TORCONTROL_COOKIE_FILEPATH torcontrol-load-cookie
[THEN]

variable (tcsocket)
variable (tcsendbuffer-len)
create (tcsaddr) /sockaddr_in alloterase
: (reset) ( -- ) 0 (tcsendbuffer-len) ! ;
: (append) ( str -- )
  dup >r torcontrol-sendbuffer (tcsendbuffer-len) @ + swap move
  r> (tcsendbuffer-len) +! ;
: (sendbuffer@) ( -- str )
  torcontrol-sendbuffer (tcsendbuffer-len) @ ;
: (cookie) ( -- str ) torcontrol-cookie TORCONTROL_COOKIE_SIZE ;
: (lf) ( -- str ) s\" \r\n" ;
: torcontrol-close-circuit ( circuit-id-n -- )
  (reset)
  CONFIG_TOR_CONTROL_AUTHMETHOD CASE
    TOR_CONTROL_AUTHMETHOD_NULL OF
      s" AUTHENTICATE " (append) (lf) (append)
    ENDOF
    TOR_CONTROL_AUTHMETHOD_COOKIE OF
      s" AUTHENTICATE " (append) (cookie) (append) (lf) (append)
    ENDOF
    ." unknown auth method with id " . abort
  ENDCASE
  
  s" CLOSECIRCUIT " (append) to-string (append) (lf) (append)
  S" QUIT" (append) (lf) (append)
  
  AF_INET SOCK_STREAM 0 socket (tcsocket) !
  
  TORCONTROL_PORT htons (tcsaddr) port w!
  TORCONTROL_ADDR (tcsaddr) sin_addr l!
  AF_INET (tcsaddr) family w!
  (tcsocket) @ (tcsaddr) /sockaddr_in connect 0<> abort" connect failed"
  (tcsocket) @ torcontrol-sendbuffer (tcsendbuffer-len) @ 0 send (tcsendbuffer-len) @ <> abort" send failed"
  BEGIN
    (tcsocket) @ torcontrol-recvbuffer TORCONTROL_RECVBUFFER_SIZE 0 recv
\    dup 0> IF
\      torcontrol-recvbuffer over type
\    THEN
    0=
  UNTIL
  (tcsocket) @ close 0<> abort" close failed" ;