removed mismatch warning
This commit is contained in:
@@ -1,6 +1,6 @@
|
|||||||
tii: a Tcl-based suite for working with ii/IDEC protocol
|
tii: a Tcl-based suite for working with ii/IDEC protocol
|
||||||
========================================================
|
========================================================
|
||||||
This suite implements the client side of ii and (partially) IDEC protocols of
|
This suite implements the client and server sides of the ii/IDEC protocol of
|
||||||
distributed, cross-platform, text-based communication (a FIDOnet successor, so
|
distributed, cross-platform, text-based communication (a FIDOnet successor, so
|
||||||
to speak). See ii-doc.txt for the protocol documentation.
|
to speak). See ii-doc.txt for the protocol documentation.
|
||||||
|
|
||||||
@@ -20,6 +20,8 @@ The tii distribution consists of the following parts:
|
|||||||
posting messages to a particular station (not included in the repo)
|
posting messages to a particular station (not included in the repo)
|
||||||
* tiix.tcl: the GUI ii/IDEC viewer that also leverages tiifetch and tiipost to
|
* tiix.tcl: the GUI ii/IDEC viewer that also leverages tiifetch and tiipost to
|
||||||
provide fetching and posting functionality
|
provide fetching and posting functionality
|
||||||
|
* tiid.tcl: the basic ii/IDEC node software that uses the same DB format
|
||||||
|
* tiid-user.tcl: user management utility for the tiid node
|
||||||
|
|
||||||
Readiness status
|
Readiness status
|
||||||
----------------
|
----------------
|
||||||
@@ -31,12 +33,12 @@ Readiness status
|
|||||||
* stations.txt (format): ready/tested
|
* stations.txt (format): ready/tested
|
||||||
* auth.txt (format): ready/tested
|
* auth.txt (format): ready/tested
|
||||||
* tiix.tcl: ready/testing
|
* tiix.tcl: ready/testing
|
||||||
|
* tiid.tcl: ready/testing
|
||||||
|
* tiid-user.tcl: ready/tested
|
||||||
* Overall status: basically ready, bugfixing in progress
|
* Overall status: basically ready, bugfixing in progress
|
||||||
|
|
||||||
Usage
|
Client usage
|
||||||
-----
|
------------
|
||||||
This section is a work in progress and will be updated as more components are
|
|
||||||
developed.
|
|
||||||
|
|
||||||
### Fetching the messages (tiifetch.tcl): ###
|
### Fetching the messages (tiifetch.tcl): ###
|
||||||
|
|
||||||
@@ -154,14 +156,49 @@ Any of the fields can be omitted, as well as the file itself.
|
|||||||
You can also use torsocks with any script invocation in order to fully cloak
|
You can also use torsocks with any script invocation in order to fully cloak
|
||||||
your originating IP address.
|
your originating IP address.
|
||||||
|
|
||||||
|
Server usage
|
||||||
|
------------
|
||||||
|
This section is in progress.
|
||||||
|
|
||||||
FAQ
|
### Starting the tiid server ###
|
||||||
---
|
|
||||||
- Does tii implement any IDEC extensions?
|
|
||||||
|
|
||||||
Only one: fetching list.txt from the station to get the entire list of echo
|
The tiid.tcl server accepts the following parameters:
|
||||||
conferences served by this station. This is something that the original ii
|
|
||||||
spec did not support.
|
tiid.tcl [port] [nodename] [dbfile]
|
||||||
|
|
||||||
|
where:
|
||||||
|
|
||||||
|
* port (default 8080) is the TCP port to listen to,
|
||||||
|
* nodename (default "tiid") is the unique node name (needed to fill the fields
|
||||||
|
like message originating address),
|
||||||
|
* dbfile (default "tii.db" in the script directory) is your database path.
|
||||||
|
|
||||||
|
The tiid server is compatible with all existing HTTP-based clients and also
|
||||||
|
with the clients that utilize Gopher/Nex transport, like tiifetch/tiix. It has
|
||||||
|
automatic protocol detection, so both HTTP and Gopher/Nex clients can connect
|
||||||
|
to the same port.
|
||||||
|
|
||||||
|
Although the tii client only can post via HTTP, the tiid server also supports
|
||||||
|
direct TCP posting with GET-like queries via Gopher/Nex protocols.
|
||||||
|
|
||||||
|
### User management on the tiid server ###
|
||||||
|
|
||||||
|
As of now, only manual user management is supported. The simplest way is to
|
||||||
|
use the included tiid-user.tcl script to perform administrative tasks.
|
||||||
|
|
||||||
|
Adding a user or changing its password (auth string):
|
||||||
|
|
||||||
|
tiid-user.tcl dbfile user someusername auth SuperSecretAuth123 acl "*"
|
||||||
|
|
||||||
|
If you don't supply the acl parameter, it will default to "*".
|
||||||
|
|
||||||
|
Changing the list of echos the user can post ("*" means all, "" means none):
|
||||||
|
|
||||||
|
tiid-user.tcl dbfile user someusername acl "echo.1,echo.2..."
|
||||||
|
|
||||||
|
Note that you need to set up ACL every time you change a user's password.
|
||||||
|
|
||||||
|
In both cases, the database file and the user field are mandatory.
|
||||||
|
|
||||||
|
|
||||||
Credits
|
Credits
|
||||||
|
|||||||
+1
-1
@@ -128,7 +128,7 @@ the = character is omitted from the end.
|
|||||||
|
|
||||||
Request: POST /u/push
|
Request: POST /u/push
|
||||||
Content-Type: application/x-www-form-urlencoded
|
Content-Type: application/x-www-form-urlencoded
|
||||||
Data: nauth=auth_string&upush=bundle_contents&echoarea=echo.name
|
Data: nauth=auth_string&upush=bundle_contents
|
||||||
Response: in case of success, must start with "message saved: ok", otherwise
|
Response: in case of success, must start with "message saved: ok", otherwise
|
||||||
with "error:"
|
with "error:"
|
||||||
|
|
||||||
|
|||||||
Executable
+44
@@ -0,0 +1,44 @@
|
|||||||
|
#!/usr/bin/env tclsh
|
||||||
|
# tiid-user: user management utility for tiid (tii node daemon)
|
||||||
|
# can work both over HTTP and Gopher/Nex
|
||||||
|
# Usage: tiid-user.tcl [dbfile] user [username] auth [password] acl [acl]
|
||||||
|
# if the username doesn't exist, it will be created
|
||||||
|
# if it does exist, the corresponding fields will be updated
|
||||||
|
# Depends upon Tcllib and sqlite3
|
||||||
|
# Created by Luxferre in 2024, released into public domain
|
||||||
|
|
||||||
|
package require sqlite3
|
||||||
|
package require sha256
|
||||||
|
|
||||||
|
if {$argc > 2} {
|
||||||
|
set dbfile [lindex $argv 0]
|
||||||
|
set kvargs [lrange $argv 1 end]
|
||||||
|
puts $kvargs
|
||||||
|
set username ""
|
||||||
|
set authhash ""
|
||||||
|
set acl "*"
|
||||||
|
if {[dict exists $kvargs user]} {
|
||||||
|
set username [dict get $kvargs user]
|
||||||
|
}
|
||||||
|
if {[dict exists $kvargs auth]} {
|
||||||
|
set rawauth [dict get $kvargs auth]
|
||||||
|
set authhash [::sha2::sha256 -hex -- [string trim $rawauth]]
|
||||||
|
}
|
||||||
|
if {[dict exists $kvargs acl]} {
|
||||||
|
set acl [dict get $kvargs acl]
|
||||||
|
}
|
||||||
|
if {$username ne ""} {
|
||||||
|
if {$authhash eq ""} { # we're only changing the ACL
|
||||||
|
set query {UPDATE `auth` SET `posting_acl` = :acl WHERE `username` = :username;}
|
||||||
|
} else { # we're inserting/updating a user
|
||||||
|
set query {INSERT INTO `auth` (`username`, `authstrhash`, `posting_acl`)
|
||||||
|
VALUES (:username, :authhash, :acl)
|
||||||
|
ON CONFLICT(`username`) DO UPDATE SET `authstrhash` = excluded.`authstrhash`,
|
||||||
|
`posting_acl` = excluded.`posting_acl`;}
|
||||||
|
}
|
||||||
|
sqlite3 db $dbfile
|
||||||
|
db eval $query
|
||||||
|
db close
|
||||||
|
puts "Changes written"
|
||||||
|
} else {puts "User field is required!"}
|
||||||
|
} else {puts "DB file and at least one key is required!"}
|
||||||
@@ -0,0 +1,517 @@
|
|||||||
|
#!/usr/bin/env tclsh
|
||||||
|
# tiid: multiprotocol tii node daemon
|
||||||
|
# can work both over HTTP and Gopher/Nex
|
||||||
|
# Usage: tiid.tcl [port] [nodename] [dbfile]
|
||||||
|
# default port is 8080, default dbfile is tii.db
|
||||||
|
# Depends upon Tcllib and sqlite3
|
||||||
|
# Created by Luxferre in 2024, released into public domain
|
||||||
|
|
||||||
|
package require sqlite3
|
||||||
|
package require sha256
|
||||||
|
|
||||||
|
set scriptpath [file normalize [info script]]
|
||||||
|
set appdir [file dirname $scriptpath]
|
||||||
|
# check if we're running from a starpack
|
||||||
|
if [string match *app-tiid $appdir] {
|
||||||
|
set appdir [file normalize [file join $appdir ".." ".." ".." ]]
|
||||||
|
}
|
||||||
|
set localdb [file join $appdir "tii.db"]
|
||||||
|
set listenport 8080
|
||||||
|
|
||||||
|
# node name, used for the originating message addresses
|
||||||
|
set nodename "tiid"
|
||||||
|
|
||||||
|
# ensure database file is created
|
||||||
|
proc createdb {fname} {
|
||||||
|
sqlite3 fdb $fname
|
||||||
|
fdb eval {
|
||||||
|
CREATE TABLE `msg` (`id` INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||||
|
`msgid` VARCHAR(20) NOT NULL UNIQUE,
|
||||||
|
`timestamp` INT NOT NULL,
|
||||||
|
`echoname` VARCHAR(120) NOT NULL,
|
||||||
|
`repto` VARCHAR(120) NOT NULL,
|
||||||
|
`msgfrom` VARCHAR(120) NOT NULL,
|
||||||
|
`msgfromaddr` VARCHAR(120) NOT NULL,
|
||||||
|
`msgto` VARCHAR(120) NOT NULL,
|
||||||
|
`subj` VARCHAR(120) NOT NULL,
|
||||||
|
`body` TEXT NOT NULL,
|
||||||
|
`blacklisted` BOOLEAN NOT NULL DEFAULT 0,
|
||||||
|
`content_id` VARCHAR(20) NOT NULL
|
||||||
|
CHECK (`blacklisted` IN (0, 1)));
|
||||||
|
CREATE TABLE `echo` (`id` INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||||
|
`name` VARCHAR(120) NOT NULL UNIQUE,
|
||||||
|
`description` VARCHAR(500));
|
||||||
|
CREATE TABLE `auth` (`id` INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||||
|
`username` VARCHAR(64) NOT NULL UNIQUE,
|
||||||
|
`authstrhash` VARCHAR(64) NOT NULL,
|
||||||
|
`posting_acl` VARCHAR(1024));
|
||||||
|
}
|
||||||
|
fdb close
|
||||||
|
}
|
||||||
|
|
||||||
|
# node logic here
|
||||||
|
|
||||||
|
# echo name validity check
|
||||||
|
proc validecho {str} {
|
||||||
|
set len [string length $str]
|
||||||
|
set validator {^[a-z0-9\-_]+\.[a-z0-9\-_\.]+$}
|
||||||
|
return [expr {$len > 2 && $len < 121 && [regexp $validator $str]}]
|
||||||
|
}
|
||||||
|
|
||||||
|
# message ID validity check
|
||||||
|
proc validmsgid {str} {
|
||||||
|
set validator {^[a-zA-Z0-9]+$}
|
||||||
|
return [expr {[string length $str] == 20 && [regexp $validator $str]}]
|
||||||
|
}
|
||||||
|
|
||||||
|
# url component decoder
|
||||||
|
proc decurl {string} {
|
||||||
|
set mapped [string map {+ { } \[ "\\\[" \] "\\\]" $ "\\$" \\ "\\\\"} $string]
|
||||||
|
encoding convertfrom utf-8 [subst [regsub -all {%([[:xdigit:]]{2})} $string {[format %c 0x\1]}]]
|
||||||
|
}
|
||||||
|
|
||||||
|
# parse query parameters into a dict
|
||||||
|
proc qparams {url args} {
|
||||||
|
set dict [list]
|
||||||
|
foreach x [split [lindex [split $url ?] 1] &] {
|
||||||
|
set x [split $x =]
|
||||||
|
if {[llength $x] < 2} { lappend x "" }
|
||||||
|
lappend dict {*}$x
|
||||||
|
}
|
||||||
|
if {[llength $args] > 0} {
|
||||||
|
return [dict get $dict [lindex $args 0]]
|
||||||
|
}
|
||||||
|
return $dict
|
||||||
|
}
|
||||||
|
|
||||||
|
# /list.txt handler
|
||||||
|
proc listechos {dbfile} {
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
set res [db eval {
|
||||||
|
SELECT CONCAT(`echo`.`name`, ':', COUNT(`msg`.`id`), ':', `echo`.`description`) FROM `echo`
|
||||||
|
LEFT JOIN `msg` ON `msg`.`echoname` = `echo`.`name` WHERE `msg`.`blacklisted` = 0
|
||||||
|
GROUP BY `msg`.`echoname` ORDER BY `echo`.`name`;
|
||||||
|
}]
|
||||||
|
db close
|
||||||
|
return "[string trim [encoding convertto utf-8 [join $res \n]]]\n"
|
||||||
|
}
|
||||||
|
|
||||||
|
# /blacklist.txt handler
|
||||||
|
proc blacklisted {dbfile} {
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
set res [db eval {SELECT `msgid` FROM `msg` WHERE `blacklisted` = 1 ORDER BY `id` ASC;}]
|
||||||
|
db close
|
||||||
|
return "[string trim [join $res \n]]\n"
|
||||||
|
}
|
||||||
|
|
||||||
|
# /m handler
|
||||||
|
proc singlemsg {dbfile msgid} {
|
||||||
|
set mdata {}
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
db eval {SELECT * from `msg` WHERE `msgid` = :msgid} msg {
|
||||||
|
append mdata {ii/ok}
|
||||||
|
if {$msg(repto) ne {}} {append mdata "/repto/$msg(repto)"}
|
||||||
|
append mdata "\n$msg(echoname)\n$msg(timestamp)"
|
||||||
|
append mdata "\n$msg(msgfrom)\n$msg(msgfromaddr)"
|
||||||
|
append mdata "\n$msg(msgto)\n$msg(subj)\n\n[join $msg(body) \n]"
|
||||||
|
}
|
||||||
|
db close
|
||||||
|
return "[string trim [encoding convertto utf-8 $mdata]]\n"
|
||||||
|
}
|
||||||
|
|
||||||
|
# /u/m handler
|
||||||
|
proc multimsg {dbfile idlist} {
|
||||||
|
set mdata {}
|
||||||
|
set query {SELECT * from `msg` WHERE `msgid` IN (}
|
||||||
|
append query [join [lmap s $idlist {string cat ' $s '}] ,] {) ORDER BY `id` ASC;}
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
db eval $query msg {
|
||||||
|
set mform {ii/ok}
|
||||||
|
if {$msg(repto) ne {}} {append mform "/repto/$msg(repto)"}
|
||||||
|
append mform "\n$msg(echoname)\n$msg(timestamp)"
|
||||||
|
append mform "\n$msg(msgfrom)\n$msg(msgfromaddr)"
|
||||||
|
append mform "\n$msg(msgto)\n$msg(subj)\n\n[join $msg(body) \n]"
|
||||||
|
append mdata $msg(msgid) ":" [binary encode base64 [encoding convertto utf-8 $mform]] \n
|
||||||
|
}
|
||||||
|
db close
|
||||||
|
return $mdata
|
||||||
|
}
|
||||||
|
|
||||||
|
# echo indexer for /e and /u/e
|
||||||
|
proc indexechos {dbfile echolist includenames offset limit} {
|
||||||
|
set rdata {}
|
||||||
|
set oquery {ORDER BY `id`}
|
||||||
|
if {$limit > 0} { # trigger limiting logic only with positive limit value
|
||||||
|
if {$offset >= 0} { # normal limiting flow
|
||||||
|
append oquery " ASC LIMIT $offset,$limit"
|
||||||
|
} else {
|
||||||
|
set reallimit [expr {-$offset}]
|
||||||
|
set realoffset [expr {$reallimit - $limit}]
|
||||||
|
if {$realoffset >= 0} {
|
||||||
|
append oquery " DESC LIMIT $realoffset,$reallimit"
|
||||||
|
} else { # invalid limit, falling back to full query
|
||||||
|
append oquery " ASC"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set query {SELECT CONCAT(`echoname`, ':', GROUP_CONCAT(`msgid`,'|' ORDER BY `id`)) AS `rowcat` FROM (}
|
||||||
|
foreach echo $echolist {
|
||||||
|
append query "SELECT * FROM (SELECT `id`, `msgid`, `echoname` FROM `msg` WHERE `echoname` = '$echo' $oquery) UNION ALL "
|
||||||
|
}
|
||||||
|
append query {SELECT NULL,NULL,NULL) GROUP BY `echoname` ORDER BY `echoname` ASC;}
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
db eval $query echorow {
|
||||||
|
if {$echorow(rowcat) ne ""} {
|
||||||
|
set eparts [split $echorow(rowcat) :]
|
||||||
|
set ename [lindex $eparts 0]
|
||||||
|
if {$ename ne ""} {
|
||||||
|
if {$includenames > 0} {
|
||||||
|
append rdata $ename \n
|
||||||
|
}
|
||||||
|
append rdata [join [split [lindex $eparts 1] "|"] \n] \n
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
db close
|
||||||
|
return $rdata
|
||||||
|
}
|
||||||
|
|
||||||
|
# /u/point handler
|
||||||
|
proc postmsg {dbfile authstr body} {
|
||||||
|
global nodename
|
||||||
|
set msgfrom ""
|
||||||
|
set acl ""
|
||||||
|
set authhash [::sha2::sha256 -hex -- [string trim $authstr]]
|
||||||
|
sqlite3 db $dbfile -readonly true
|
||||||
|
db eval {SELECT `id`, `username`, `posting_acl` FROM `auth` WHERE `authstrhash` = :authhash} user {
|
||||||
|
set msgfrom $user(username)
|
||||||
|
set msgfromaddr "$nodename,$user(id)"
|
||||||
|
set acl [string trim $user(posting_acl)]
|
||||||
|
}
|
||||||
|
db close
|
||||||
|
|
||||||
|
if {$msgfrom ne ""} {
|
||||||
|
# auth successful, process the body
|
||||||
|
set p2nmsg [split [encoding convertfrom utf-8 [binary decode base64 $body]] "\n"]
|
||||||
|
if {[llength $p2nmsg] > 4} {
|
||||||
|
set echoname [string trim [lindex $p2nmsg 0]]
|
||||||
|
if {$acl ne "*"} { # check if the user can post in the echo
|
||||||
|
set posting_allowed 0
|
||||||
|
set acl [split $acl ,]
|
||||||
|
foreach acl_echo $acl {
|
||||||
|
if {$echoname eq $acl_echo} {
|
||||||
|
set posting_allowed 1
|
||||||
|
break
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {posting_allowed eq 0} {
|
||||||
|
return "posting to this echo is not allowed for this user"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set msgto [string trim [lindex $p2nmsg 1]]
|
||||||
|
set subj [string trim [lindex $p2nmsg 2]]
|
||||||
|
set line4 [string trim [lindex $p2nmsg 4]]
|
||||||
|
if {[string match @repto:* $line4]} {
|
||||||
|
set repto [string range $line4 7 end]
|
||||||
|
if {![validmsgid $repto]} {return "invalid repto message ID"}
|
||||||
|
set msgbody [join [lrange $p2nmsg 5 end] "\n"]
|
||||||
|
} else {
|
||||||
|
set repto ""
|
||||||
|
set msgbody [join [lrange $p2nmsg 4 end] "\n"]
|
||||||
|
}
|
||||||
|
set timestamp [clock seconds]
|
||||||
|
set mform {ii/ok}
|
||||||
|
if {$repto ne {}} {append mform "/repto/$repto"}
|
||||||
|
append mform "\n$echoname\n$timestamp"
|
||||||
|
append mform "\n$msgfrom\n$msgfromaddr"
|
||||||
|
append mform "\nmsgto\n$subj\n\n$msgbody"
|
||||||
|
# generate the message ID
|
||||||
|
set hash [::sha2::sha256 -bin -- $mform]
|
||||||
|
set trimbased [string range [binary encode base64 $hash] 0 19]
|
||||||
|
set msgid [string map {+ A - A / z _ z} $trimbased]
|
||||||
|
# perform the insertion
|
||||||
|
set msgbody [split $msgbody "\n"]
|
||||||
|
sqlite3 db $dbfile
|
||||||
|
db eval {INSERT OR IGNORE INTO `msg` (`msgid`, `timestamp`, `echoname`, `repto`,
|
||||||
|
`msgfrom`, `msgfromaddr`, `msgto`, `subj`, `body`, `blacklisted`, `content_id`)
|
||||||
|
VALUES (:msgid, :timestamp, :echoname, :repto, :msgfrom, :msgfromaddr, :msgto,
|
||||||
|
:subj, :msgbody , 0, :msgid);}
|
||||||
|
db close
|
||||||
|
return "msg ok"
|
||||||
|
} else {return "invalid message structure"}
|
||||||
|
} else {return "no auth"}
|
||||||
|
}
|
||||||
|
|
||||||
|
# /u/push handler
|
||||||
|
proc postbundle {dbfile authstr body} {
|
||||||
|
return "push logic is not implemented"
|
||||||
|
}
|
||||||
|
|
||||||
|
# / handler (index page)
|
||||||
|
proc indexpage {} {
|
||||||
|
global nodename
|
||||||
|
return [string cat "status: ready\nserver: tiid\nnodename: $nodename\n" \
|
||||||
|
{apis: /list.txt /blacklist.txt /e /m /u/e /u/m /u/point} \n]
|
||||||
|
}
|
||||||
|
|
||||||
|
# TCP logic here
|
||||||
|
|
||||||
|
# error report/reply
|
||||||
|
proc reperror {sock ishttp errmsg} {
|
||||||
|
set errmsg "error: $errmsg\n"
|
||||||
|
if {$ishttp eq 1} {
|
||||||
|
set msglen [string length $errmsg]
|
||||||
|
set hdrs "Content-Type: text/plain;charset=utf-8\r\nContent-Length: $msglen\r\nConnection: close\r\n"
|
||||||
|
puts -nonewline $sock "HTTP/1.0 400 Bad Request\r\n$hdrs\r\n$errmsg"
|
||||||
|
} else {
|
||||||
|
puts -nonewline $sock "$errmsg"
|
||||||
|
}
|
||||||
|
flush $sock
|
||||||
|
}
|
||||||
|
|
||||||
|
# successful reply with data
|
||||||
|
proc repdata {sock ishttp data} {
|
||||||
|
if {$ishttp eq 1} {
|
||||||
|
set msglen [string length $data]
|
||||||
|
set hdrs "Content-Type: text/plain;charset=utf-8\r\nContent-Length: $msglen\r\nConnection: close\r\n"
|
||||||
|
puts -nonewline $sock "HTTP/1.0 200 OK\r\n$hdrs\r\n$data"
|
||||||
|
} else {
|
||||||
|
puts -nonewline $sock $data
|
||||||
|
}
|
||||||
|
flush $sock
|
||||||
|
}
|
||||||
|
|
||||||
|
# path router
|
||||||
|
# it only must write to the socket, not read from it or close it
|
||||||
|
# supported paths: /e, /m, /u/e, /u/m, /u/point, /list.txt, /blacklist.txt
|
||||||
|
proc routepath {dbfile sock ishttp path body} {
|
||||||
|
fconfigure $sock -translation binary
|
||||||
|
set pathparts [split [string trim $path] /]
|
||||||
|
if {[llength $pathparts] > 1} {
|
||||||
|
switch -- [lindex $pathparts 1] {
|
||||||
|
u { # /u/ subrequests
|
||||||
|
if {[llength $pathparts] > 2} {
|
||||||
|
switch -- [lindex $pathparts 2] {
|
||||||
|
e {
|
||||||
|
set erange [lrange $pathparts 3 end]
|
||||||
|
if {[llength $erange] > 0} {
|
||||||
|
set limit 0
|
||||||
|
set offset 0
|
||||||
|
set lastel [lindex $erange end]
|
||||||
|
if {[string match *?:?* $lastel]} { # slice detected
|
||||||
|
set sparts [split $lastel :]
|
||||||
|
set offset [expr {int([lindex $sparts 0])}]
|
||||||
|
set limit [expr {int([lindex $sparts 1])}]
|
||||||
|
set erange [lrange $erange 0 end-1]
|
||||||
|
}
|
||||||
|
# validate the rest of the echo list
|
||||||
|
set erange [lmap ename $erange {expr {
|
||||||
|
[validecho $ename] ? $ename : [continue]
|
||||||
|
}}]
|
||||||
|
if {[llength $erange] > 0} { # recheck length after validation
|
||||||
|
repdata $sock $ishttp [indexechos $dbfile $erange 1 $offset $limit]
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
m { # validate and shape the message ID list
|
||||||
|
set mrange [lmap mid [lrange $pathparts 3 end] {expr {
|
||||||
|
[validmsgid $mid] ? $mid : [continue]
|
||||||
|
}}]
|
||||||
|
if {[llength $mrange] > 0} { # we have some valid messages
|
||||||
|
repdata $sock $ishttp [multimsg $dbfile $mrange]
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
point {
|
||||||
|
set msgbody ""
|
||||||
|
set authstr ""
|
||||||
|
if {$body ne ""} { # HTTP POST request
|
||||||
|
set params [qparams "?$body"]
|
||||||
|
if {[dict exists $params pauth]} {
|
||||||
|
set authstr [decurl [dict get $params pauth]]
|
||||||
|
}
|
||||||
|
if {[dict exists $params tmsg]} {
|
||||||
|
set msgbody [decurl [dict get $params tmsg]]
|
||||||
|
}
|
||||||
|
} else { # HTTP GET or a bare TCP request
|
||||||
|
if {[llength $pathparts] > 4} {
|
||||||
|
set authstr [lindex $pathparts 3]
|
||||||
|
set msgbody [join [lrange $pathparts 4 end] /]
|
||||||
|
# perform urlsafe substitution
|
||||||
|
set msgbody [string map {- + _ /} $msgbody]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$authstr ne "" && $msgbody ne ""} {
|
||||||
|
set postres [postmsg $dbfile $authstr $msgbody]
|
||||||
|
if [string match "msg ok*" $postres] {
|
||||||
|
repdata $sock $ishttp $postres
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp $postres
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
push {
|
||||||
|
set msgbody ""
|
||||||
|
set authstr ""
|
||||||
|
if {$body ne ""} { # HTTP POST request
|
||||||
|
set params [qparams "?$body"]
|
||||||
|
if {[dict exists $params pauth]} {
|
||||||
|
set authstr [decurl [dict get $params nauth]]
|
||||||
|
}
|
||||||
|
if {[dict exists $params tmsg]} {
|
||||||
|
set msgbody [decurl [dict get $params upush]]
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "/u/push is only available over HTTP POST"
|
||||||
|
return
|
||||||
|
}
|
||||||
|
if {$authstr ne "" && $msgbody ne ""} {
|
||||||
|
set postres [postbundle $dbfile $authstr $msgbody]
|
||||||
|
if [string match "message saved: ok*" $postres] {
|
||||||
|
repdata $sock $ishttp $postres
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp $postres
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
e {
|
||||||
|
if {[llength $pathparts] > 2} {
|
||||||
|
set echoname [string trim [lindex $pathparts 2]]
|
||||||
|
if {[validecho $echoname]} {
|
||||||
|
repdata $sock $ishttp [indexechos $dbfile [list $echoname] 0 0 0]
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
m {
|
||||||
|
if {[llength $pathparts] > 2} {
|
||||||
|
set mid [string trim [lindex $pathparts 2]]
|
||||||
|
if {[validmsgid $mid]} {
|
||||||
|
repdata $sock $ishttp [singlemsg $dbfile $mid]
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
list.txt {
|
||||||
|
repdata $sock $ishttp [listechos $dbfile]
|
||||||
|
}
|
||||||
|
blacklist.txt {
|
||||||
|
repdata $sock $ishttp [blacklisted $dbfile]
|
||||||
|
}
|
||||||
|
{} {
|
||||||
|
repdata $sock $ishttp [indexpage]
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
reperror $sock $ishttp "invalid request"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# main multiproto request handler
|
||||||
|
proc reqhandler {dbfile sock} {
|
||||||
|
# read the first request line
|
||||||
|
# ignore all invalid requests by closing the connection
|
||||||
|
if {[gets $sock line] >= 0} {
|
||||||
|
if {[string match /* $line]} { # bare TCP request (Gopher/Nex)
|
||||||
|
routepath $dbfile $sock 0 [string trim $line] {}
|
||||||
|
} elseif {[string match -nocase {GET /*} $line]} { # HTTP GET request
|
||||||
|
set rparts [split [string trimleft $line]]
|
||||||
|
if {[llength $rparts] > 1} { # valid GET request
|
||||||
|
routepath $dbfile $sock 1 [lindex $rparts 1] {}
|
||||||
|
}
|
||||||
|
} elseif {[string match -nocase {POST /*} $line]} { # HTTP POST request
|
||||||
|
set rparts [split [string trimleft $line]]
|
||||||
|
if {[llength $rparts] > 1} { # valid POST request, read POST headers and data
|
||||||
|
set hdrread 0
|
||||||
|
set hdata {}
|
||||||
|
set pdata {}
|
||||||
|
while {$hdrread < 1} {
|
||||||
|
if {[eof $sock] || [catch {gets $sock line}]} {
|
||||||
|
break
|
||||||
|
} else {
|
||||||
|
if {$line eq ""} {
|
||||||
|
incr hdrread
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set hparts [split [string trimleft $line] :]
|
||||||
|
if {[llength $hparts] > 1} {
|
||||||
|
set hname [string tolower [string trimright [lindex $hparts 0]]]
|
||||||
|
set hval [string trim [lindex $hparts 1]]
|
||||||
|
dict set hdata $hname $hval
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set readlen 0
|
||||||
|
if {[dict exists $hdata content-length]} {
|
||||||
|
set readlen [dict get $hdata content-length]
|
||||||
|
}
|
||||||
|
if {$readlen > 0} { # read the data defined by content-length header
|
||||||
|
fconfigure $sock -translation {binary lf} -buffering none
|
||||||
|
set pdata [read $sock $readlen]
|
||||||
|
}
|
||||||
|
routepath $dbfile $sock 1 [lindex $rparts 1] [string trimleft $pdata]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
catch {close $sock}
|
||||||
|
}
|
||||||
|
|
||||||
|
# request accepter
|
||||||
|
proc reqaccept {dbfile sock addr port} {
|
||||||
|
# set linefeed as the newline character for output
|
||||||
|
# and translate anything into LF for input
|
||||||
|
fconfigure $sock -translation {auto lf} -buffering line
|
||||||
|
fileevent $sock readable [list reqhandler $dbfile $sock]
|
||||||
|
}
|
||||||
|
|
||||||
|
# entry point
|
||||||
|
if {$argc > 0} {
|
||||||
|
set listenport [expr {int([lindex $argv 0])}]
|
||||||
|
if {$listenport < 1 || $listenport > 65535} {
|
||||||
|
puts "Invalid port specified!"
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
if {$argc > 1} {
|
||||||
|
set nodename [string trim [lindex $argv 1]]
|
||||||
|
}
|
||||||
|
if {$argc > 2} {
|
||||||
|
set localdb [file normalize [lindex $argv 2]]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# create the db file if it doesn't exist
|
||||||
|
if {![file exists $localdb]} {
|
||||||
|
puts "No DB found, creating..."
|
||||||
|
createdb $localdb
|
||||||
|
}
|
||||||
|
|
||||||
|
# start the server
|
||||||
|
puts "tiid daemon $nodename listening on port $listenport"
|
||||||
|
socket -server [list reqaccept $localdb] $listenport
|
||||||
|
vwait forever
|
||||||
+2
-2
@@ -131,14 +131,14 @@ proc getfile {url} {
|
|||||||
}
|
}
|
||||||
switch $scheme {
|
switch $scheme {
|
||||||
gophers - gopher - finger - nex {
|
gophers - gopher - finger - nex {
|
||||||
if {$scheme eq "gophers"} {set localtls 1}
|
if {$scheme eq "gophers"} {set localtls 2} else {set localtls 0}
|
||||||
reqresp $host $port $sel $localtls utf-8
|
reqresp $host $port $sel $localtls utf-8
|
||||||
set body "$sock_response"
|
set body "$sock_response"
|
||||||
set sock_response ""
|
set sock_response ""
|
||||||
return $body
|
return $body
|
||||||
}
|
}
|
||||||
gemini - spartan {
|
gemini - spartan {
|
||||||
if {$scheme eq "gemini"} {set localtls 1}
|
if {$scheme eq "gemini"} {set localtls 1} else {set localtls 0}
|
||||||
reqresp $host $port $sel $localtls utf-8
|
reqresp $host $port $sel $localtls utf-8
|
||||||
set body "$sock_response"
|
set body "$sock_response"
|
||||||
set sock_response ""
|
set sock_response ""
|
||||||
|
|||||||
@@ -159,6 +159,7 @@ proc tiix_viewecho {} {
|
|||||||
set linkcount 0
|
set linkcount 0
|
||||||
set linklist ""
|
set linklist ""
|
||||||
msgdb eval $query msg { # iterate over the list after filtering
|
msgdb eval $query msg { # iterate over the list after filtering
|
||||||
|
set msg(msgid) [string trim $msg(msgid)]
|
||||||
set globalline [string repeat = 80]
|
set globalline [string repeat = 80]
|
||||||
set hdrline [string repeat - 80]
|
set hdrline [string repeat - 80]
|
||||||
set tz ""
|
set tz ""
|
||||||
@@ -170,9 +171,6 @@ proc tiix_viewecho {} {
|
|||||||
$textw insert end "\[$renderedts\] "
|
$textw insert end "\[$renderedts\] "
|
||||||
linkinsert $textw $msg(msgid) 1
|
linkinsert $textw $msg(msgid) 1
|
||||||
set msg(content_id) [string trim $msg(content_id)]
|
set msg(content_id) [string trim $msg(content_id)]
|
||||||
if {$msg(msgid) ne $msg(content_id)} {
|
|
||||||
$textw insert end " (ID hash mismatch!)"
|
|
||||||
}
|
|
||||||
set msg(echoname) [string trim $msg(echoname)]
|
set msg(echoname) [string trim $msg(echoname)]
|
||||||
set msg(msgfrom) [string trim $msg(msgfrom)]
|
set msg(msgfrom) [string trim $msg(msgfrom)]
|
||||||
set msg(msgfromaddr) [string trim $msg(msgfromaddr)]
|
set msg(msgfromaddr) [string trim $msg(msgfromaddr)]
|
||||||
|
|||||||
Reference in New Issue
Block a user