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

98 lines
3.3 KiB
Plaintext
Raw Permalink Normal View History

2024-02-17 13:26:14 -05:00
\ 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" ;