109 lines
3.5 KiB
Tcl
Executable File
109 lines
3.5 KiB
Tcl
Executable File
#!/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!"}
|
|
|