#!/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} {
  set rooturl [string trim $rooturl]
  set authstr [string trim $authstr]
  set echoname [string trim $echoname]
  set repto [string trim $repto]
  set msgto [string trim $msgto]
  set subj [string trim $subj]
  set text [string trimright $text]
  if {$repto ne ""} {set text "@repto:$repto\r\n$text"}
  set rawdata "$echoname\n$msgto\n$subj\n\n$text"
  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 ".." ".." ".." ]]
}

# populate general HTTP configuration 
set cfgfile [file join $appdir "config.txt"]
if {[file exists $cfgfile]} {
  set cfg [readfile $cfgfile]
  if {[dict exists $cfg useragent]} {
    ::http::config -useragent [dict get $cfg useragent] 
  }
  if {[dict exists $cfg proxyhost]} {
    ::http::config -proxyhost [dict get $cfg proxyhost] 
  }
  if {[dict exists $cfg proxyport]} {
    ::http::config -proxyport [dict get $cfg proxyport] 
  }
}

# get auth string mapping
set authmap ""
set authfile [file join $appdir "auth.txt"]
if {[file exists $authfile]} {
  set authmap [readfile $authfile]
}

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]
  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!"}