tii

Tcl-based suite for working with ii/idec protocol
git clone git://git.luxferre.top/tii.git
Log | Files | Refs | README

tiipost.tcl (3574B)


      1 #!/usr/bin/env tclsh
      2 # tiipost: post text data from stdin to an echo by a station URL
      3 # Usage: echo my_post_text | tiipost.tcl station_root_url echo_name msgto subj [repto]
      4 # tiipost looks at the auth string in the auth.txt of the script root
      5 # All parameters except repto are mandatory
      6 # Created by Luxferre in 2024, released into public domain
      7 
      8 package require http
      9 
     10 # autodetect TclTLS support and enable HTTPS request support if detected
     11 set tls_support 0
     12 catch {package require tls; set tls_support 1}
     13 if {$tls_support eq 1} {
     14   ::http::register https 443 [list ::tls::socket -autoservername true]
     15 }
     16 
     17 # file read helper
     18 proc readfile {fname} {
     19   if {$fname eq {stdin}} {
     20     set fp stdin
     21   } else {
     22     set fp [open $fname r]
     23   }
     24   fconfigure $fp -encoding utf-8
     25   set data [read $fp]
     26   close $fp
     27   return $data
     28 }
     29 
     30 # main data posting function
     31 proc postiidata {rooturl authstr echoname msgto subj repto text} {
     32   set rooturl [string trim $rooturl]
     33   set authstr [string trim $authstr]
     34   set echoname [string trim $echoname]
     35   set repto [string trim $repto]
     36   set msgto [string trim $msgto]
     37   set subj [string trim $subj]
     38   set text [string trimright $text]
     39   if {$repto ne ""} {set text "@repto:$repto\r\n$text"}
     40   set rawdata "$echoname\n$msgto\n$subj\n\n$text"
     41   set rawdata [encoding convertto utf-8 $rawdata]
     42   set based [binary encode base64 $rawdata]
     43   # perform the posting if the length fits
     44   if {[string length $based] <= 87382} {
     45     set posturl [regsub -all {([^:])//} [string cat $rooturl "/u/point"] {\1/}]
     46     set postquery [::http::formatQuery pauth $authstr tmsg $based]
     47     set hs [::http::geturl $posturl -query $postquery -timeout 8000]
     48     set resdata [::http::data $hs]
     49     set resobj ""
     50     dict set resobj status [string match "msg ok*" $resdata]
     51     dict set resobj result $resdata
     52     return $resobj
     53   } else {return {status 0 result {Request overflow!}}}
     54 }
     55 
     56 # end of procs, start the entrypoint
     57 if {![info exists argv0] || [file tail [info script]] ne [file tail $argv0]} {return}
     58 
     59 set scriptpath [file normalize [info script]]
     60 set appdir [file dirname $scriptpath]
     61 # check if we're running from a starpack
     62 if [string match *app-tiipost $appdir] {
     63   set appdir [file normalize [file join $appdir ".." ".." ".." ]]
     64 }
     65 
     66 # populate general HTTP configuration 
     67 set cfgfile [file join $appdir "config.txt"]
     68 if {[file exists $cfgfile]} {
     69   set cfg [readfile $cfgfile]
     70   if {[dict exists $cfg useragent]} {
     71     ::http::config -useragent [dict get $cfg useragent] 
     72   }
     73   if {[dict exists $cfg proxyhost]} {
     74     ::http::config -proxyhost [dict get $cfg proxyhost] 
     75   }
     76   if {[dict exists $cfg proxyport]} {
     77     ::http::config -proxyport [dict get $cfg proxyport] 
     78   }
     79 }
     80 
     81 # get auth string mapping
     82 set authmap ""
     83 set authfile [file join $appdir "auth.txt"]
     84 if {[file exists $authfile]} {
     85   set authmap [readfile $authfile]
     86 }
     87 
     88 if {$argc > 3} {
     89   set sturl [string trim [lindex $argv 0]]
     90   set echoname [string trim [lindex $argv 1]]
     91   set msgto [string trim [lindex $argv 2]]
     92   set subj [string trim [lindex $argv 3]]
     93   set repto ""
     94   if {$argc > 4} {
     95     set repto [string trim [lindex $argv 4]]
     96   }
     97   set authstr ""
     98   if {[dict exists $authmap $sturl]} {
     99     set authstr [dict get $authmap $sturl]
    100   }
    101   set msgtext [readfile stdin]
    102   puts "Posting the message to $sturl..."
    103   set res [postiidata $sturl $authstr $echoname $msgto $subj $repto $msgtext]
    104   set status [dict get $res status]
    105   set result [dict get $res result]
    106   if {$status} {puts "Success: $result"} else {puts "Error: $result"}
    107 } else {puts "Not all mandatory parameters specified!"}
    108