removed mismatch warning
This commit is contained in:
Luxferre
@@ -1,6 +1,6 @@
|
||||
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
|
||||
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)
|
||||
* tiix.tcl: the GUI ii/IDEC viewer that also leverages tiifetch and tiipost to
|
||||
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
|
||||
----------------
|
||||
@@ -31,12 +33,12 @@ Readiness status
|
||||
* stations.txt (format): ready/tested
|
||||
* auth.txt (format): ready/tested
|
||||
* tiix.tcl: ready/testing
|
||||
* tiid.tcl: ready/testing
|
||||
* tiid-user.tcl: ready/tested
|
||||
* Overall status: basically ready, bugfixing in progress
|
||||
|
||||
Usage
|
||||
-----
|
||||
This section is a work in progress and will be updated as more components are
|
||||
developed.
|
||||
Client usage
|
||||
------------
|
||||
|
||||
### 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
|
||||
your originating IP address.
|
||||
|
||||
Server usage
|
||||
------------
|
||||
This section is in progress.
|
||||
|
||||
FAQ
|
||||
---
|
||||
- Does tii implement any IDEC extensions?
|
||||
### Starting the tiid server ###
|
||||
|
||||
Only one: fetching list.txt from the station to get the entire list of echo
|
||||
conferences served by this station. This is something that the original ii
|
||||
spec did not support.
|
||||
The tiid.tcl server accepts the following parameters:
|
||||
|
||||
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
|
||||
|
||||
+1
-1
@@ -128,7 +128,7 @@ the = character is omitted from the end.
|
||||
|
||||
Request: POST /u/push
|
||||
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
|
||||
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 {
|
||||
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
|
||||
set body "$sock_response"
|
||||
set sock_response ""
|
||||
return $body
|
||||
}
|
||||
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
|
||||
set body "$sock_response"
|
||||
set sock_response ""
|
||||
|
||||
@@ -159,6 +159,7 @@ proc tiix_viewecho {} {
|
||||
set linkcount 0
|
||||
set linklist ""
|
||||
msgdb eval $query msg { # iterate over the list after filtering
|
||||
set msg(msgid) [string trim $msg(msgid)]
|
||||
set globalline [string repeat = 80]
|
||||
set hdrline [string repeat - 80]
|
||||
set tz ""
|
||||
@@ -170,9 +171,6 @@ proc tiix_viewecho {} {
|
||||
$textw insert end "\[$renderedts\] "
|
||||
linkinsert $textw $msg(msgid) 1
|
||||
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(msgfrom) [string trim $msg(msgfrom)]
|
||||
set msg(msgfromaddr) [string trim $msg(msgfromaddr)]
|
||||
|
||||
Reference in New Issue
Block a user