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