Implemented the posting script

README

@@ -25,13 +25,13 @@ The tii repo consists of the following parts:
 Readiness status
 ----------------
 * tiifetch.tcl: ready/tested
-* tiipost.tcl: planned
+* tiipost.tcl: ready/tested
 * tiiview.tcl: ready/tested
 * tiidb (format): ready/tested
 * stations.txt (format): ready/tested
-* auth.txt (format): ready to be implemented
+* auth.txt (format): ready/tested
 * tiix.tcl: planned
-* Overall status: work in progress
+* Overall status: CLI-ready. work in progress for GUI
 
 Usage
 -----
@@ -106,6 +106,27 @@ filtering has been done. Also note that the search is done within all fields
 of the message. E.g. h100/retro will find the retro-themed messages among the
 first 100 of them.
 
+### Posting the messages from CLI (tiipost.tcl): ###
+
+echo my_post_text | tiipost.tcl station_root_url echo_name msgto subj [repto]
+
+The tiipost.tcl script accepts the message body from the standard input. The
+body must be provided in UTF-8 encoding and all command line parameters except
+[repto] (reply-to ID) are mandatory.
+
+The script will look for the auth.txt file in its directory, with the format:
+
+station_url_1 password1
+station_url_2 password2
+...
+
+If the station root URL matches one of the lines in auth.txt, it automatically
+will use the password as the authstring when posting to the station.
+
+On success, tiipost.tcl will output a message that starts with "Success", in
+case of an error the line will start with "Error". The server-side description
+will follow this success or error status.
+
 Message database format
 -----------------------
 The tiidb format is based upon the official ii/IDEC developer recommendations

tiipost.tcl

@@ -0,0 +1,95 @@
+#!/usr/bin/env tclsh
+# tiipost: post text data from stdin to an echo by a station URL
+# Usage: echo my_post_text | tiipost.tcl station_root_url echo_name msgto subj [repto]
+# tiipost looks at the auth string in the auth.txt of the script root
+# All parameters except repto are mandatory
+# Created by Luxferre in 2024, released into public domain
+
+package require http
+
+# autodetect TclTLS support and enable HTTPS request support if detected
+set tls_support 0
+catch {package require tls; set tls_support 1}
+if {$tls_support eq 1} {
+  ::http::register https 443 [list ::tls::socket -autoservername true]
+}
+
+# file read helper
+proc readfile {fname} {
+  if {$fname eq {stdin}} {
+    set fp stdin
+  } else {
+    set fp [open $fname r]
+  }
+  fconfigure $fp -encoding utf-8
+  set data [read $fp]
+  close $fp
+  return $data
+}
+
+# main data posting function
+proc postiidata {rooturl authstr echoname msgto subj repto text add_enc} {
+  if {$repto ne ""} {set text "@repto:$repto\r\n$text"}
+  set rawdata "$echoname\n$msgto\n$subj\n\n$text"
+  if {$add_enc eq 1} {
+    set rawdata [encoding convertto utf-8 $rawdata]
+  }
+  set based [binary encode base64 $rawdata]
+  # perform the posting if the length fits
+  if {[string length $based] <= 87382} {
+    set posturl [regsub -all {([^:])//} [string cat $rooturl "/u/point"] {\1/}]
+    set postquery [::http::formatQuery pauth $authstr tmsg $based]
+    set hs [::http::geturl $posturl -query $postquery -timeout 8000]
+    set resdata [::http::data $hs]
+    set resobj ""
+    dict set resobj status [string match "msg ok*" $resdata]
+    dict set resobj result $resdata
+    return $resobj
+  } else {return {status 0 result {Request overflow!}}}
+}
+
+# end of procs, start the entrypoint
+if {![info exists argv0] || [file tail [info script]] ne [file tail $argv0]} {return}
+
+set scriptpath [file normalize [info script]]
+set appdir [file dirname $scriptpath]
+# check if we're running from a starpack
+if [string match *app-tiipost $appdir] {
+  set appdir [file normalize [file join $appdir ".." ".." ".." ]]
+}
+# auth string mapping
+set authmap ""
+set authfile [file join $appdir "auth.txt"]
+if {[file exists $authfile]} {
+  set authdata [readfile $authfile]
+  set authlist [split $authdata "\n"]
+  foreach authline $authlist {
+    set authline [string trim $authline]
+    if {$authline ne ""} {
+      set parts [split $authline " \t"]
+      dict set authmap [string trim [lindex $parts 0]] [string trim [lindex $parts 1]]
+    }
+  }
+}
+
+if {$argc > 3} {
+  set sturl [string trim [lindex $argv 0]]
+  set echoname [string trim [lindex $argv 1]]
+  set msgto [string trim [lindex $argv 2]]
+  set subj [string trim [lindex $argv 3]]
+  set repto ""
+  if {$argc > 4} {
+    set repto [string trim [lindex $argv 4]]
+  }
+  set authstr ""
+  if {[dict exists $authmap $sturl]} {
+    set authstr [dict get $authmap $sturl]
+  }
+  set msgtext [readfile stdin]
+  puts "Posting the message to $sturl..."
+  set res [postiidata $sturl $authstr $echoname $msgto $subj $repto $msgtext 1]
+  set status [dict get $res status]
+  set result [dict get $res result]
+  if {$status} {puts "Success: $result"} else {puts "Error: $result"}
+} else {puts "Not all mandatory parameters specified!"}
+