commit 92fcea502ee5cb34e01f9c7b7774ecdb82da1161
parent 91b42cfb9e3953dad076de3aaf0ec1b37b9f4c7d
Author: Luxferre <lux@ferre>
Date: Thu, 21 Nov 2024 19:27:40 +0200
removed mismatch warning
Diffstat:
| M | README | | | 59 | ++++++++++++++++++++++++++++++++++++++++++++++++----------- |
| M | ii-doc.txt | | | 2 | +- |
| A | tiid-user.tcl | | | 44 | ++++++++++++++++++++++++++++++++++++++++++++ |
| A | tiid.tcl | | | 517 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | tiifetch.tcl | | | 4 | ++-- |
| M | tiix.tcl | | | 4 | +--- |
6 files changed, 613 insertions(+), 17 deletions(-)
diff --git a/README b/README
@@ -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
diff --git a/ii-doc.txt b/ii-doc.txt
@@ -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:"
diff --git a/tiid-user.tcl b/tiid-user.tcl
@@ -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!"}
diff --git a/tiid.tcl b/tiid.tcl
@@ -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
diff --git a/tiifetch.tcl b/tiifetch.tcl
@@ -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 ""
diff --git a/tiix.tcl b/tiix.tcl
@@ -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)]
