luxferre/tii
1
0
Fork 0
Code Actions Activity

[WIP] initial upload

Browse Source
This commit is contained in:
Luxferre
2024-10-21 17:09:52 +03:00
commit c34fba498a
1 changed files with 290 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tiifetch.tcl
Executable
+290
View File
@@ -0,0 +1,290 @@
#!/usr/bin/env tclsh
# tiifetch: fetch all data from an ii/idec station into the local text db
# (see https://github.com/idec-net/new-docs/blob/master/protocol-en.md)
# Usage: tiifetch station_http_url [echos] [db_dir]
# The echo list should be delimited with slash (/), comma (,) or semicolon (;)
# if no echos are specified (or "" is passed), then list.txt will be fetched
# and then all missing echo content from it will be downloaded
# If db_dir isn't specified, it's fetched and merged into the
# tiidb directory in the program root
# with echoconfs and messages respectively
# This component only fetches the messages, doesn't parse or display them
# Supported protocols: HTTP, HTTPS, Gemini, Spartan, Gopher/Finger/Nex
# Depends on Tcllib for URI parsing
# Created by Luxferre in 2024, released into public domain
package require http
package require uri
# 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]
}
proc url2dict {inputurl} {
set out [dict create]
if [regexp {^(.*)://} $inputurl _ lscheme] {
dict set out scheme $lscheme
} else {
dict set out handler "render_handler_invalid"
return $out
}
set rawout [::uri::split [regsub {^.*://} $inputurl "http://"]]
set rhost [dict get $rawout host]
set rpath [dict get $rawout path]
set rport [dict get $rawout port]
set secondarydata [dict get $rawout query]
dict set out host $rhost
set selector $rpath
dict set out handler "render_handler_$lscheme"
# protocol-specific request logic
switch "$lscheme" {
gophers -
gopher {
if {$rport eq ""} {set rport 70}
set selector [string cat [string range $rpath 1 end] "\r\n"]
dict set out handler render_handler_gopher
}
finger {
if {$rport eq ""} {set rport 79}
set selector "$selector\r\n"
}
spartan {
if {$rport eq ""} {set rport 300}
if {$rpath eq ""} {set rpath "/"}
if {![string match "/*" $rpath]} {
set rpath "/$rpath"
}
set blen [string length $secondarydata]
set selector "$rhost $rpath $blen\r\n$secondarydata"
}
nex {
if {$rport eq ""} {set rport 1900}
set selector "$selector\r\n"
}
gemini {
if {$rport eq ""} {set rport 1965}
set selector "$inputurl\r\n"
}
default {dict set out handler render_handler_none}
}
dict set out path $rpath
dict set out selector $selector
dict set out port $rport
return $out
}
proc reqresp {host port reqline is_tls encoding} {
global sock_response
set sock_net_timeout 5000
set sock 0
if {$is_tls eq 1} {
catch {set sock [::tls::socket -autoservername true -async $host $port]}
} elseif {$is_tls eq 2} {
catch {set sock [::tls::socket -autoservername true -async $host $port]}
if {$sock eq 0} {catch {set sock [socket -async $host $port]}}
} else {
catch {set sock [socket -async $host $port]}
}
if {$sock eq 0} {set sock_response ""; return}
global rcv_end_$sock
unset -nocomplain rcv_end_$sock
if {$encoding eq ""} {set encoding utf-8}
fconfigure $sock -translation binary -buffering none -encoding $encoding
fileevent $sock writable [list connected $sock $reqline]
proc connected {sock reqline} {
fileevent $sock writable {}
puts -nonewline $sock "$reqline"
flush $sock
fileevent $sock readable [list rdbl $sock]
}
set sock_response ""
proc rdbl {sock} {
global sock_response rcv_end_$sock
while {![eof $sock]} {
append sock_response [read $sock]
}
set rcv_end_$sock 0
}
after $sock_net_timeout "global rcv_end_$sock; set rcv_end_$sock 1"
vwait rcv_end_$sock
catch {close $sock}
unset -nocomplain rcv_end_$sock
}
# file download helper
proc getfile {url} {
set url [regsub -all {([^:])//} $url {\1/}]
set urlparts [url2dict $url]
set scheme [dict get $urlparts scheme]
set host [dict get $urlparts host]
set port [dict get $urlparts port]
set sel [dict get $urlparts selector]
global sock_response tls_support
switch $tls_support {
0 {set localtls 0}
1 {set localtls 2}
}
switch $scheme {
gophers - gopher - finger - nex {
if {$scheme eq "gophers"} {set localtls 1}
reqresp $host $port $sel $localtls utf-8
set body "$sock_response"
set sock_response ""
return $body
}
gemini - spartan {
if {$scheme eq "gemini"} {set localtls 1}
reqresp $host $port $sel $localtls utf-8
set body "$sock_response"
set sock_response ""
if {[regexp {^([^\n]*)\n} $body _ statusline]} {
set statusline [string trimright $statusline]
set statusparts [split $statusline " "]
set statuscode [lindex $statusparts 0]
set mainstatuscode [string index $statuscode 0]
if {$mainstatuscode eq 2} {
regsub {.*?\n} $body "" body
return $body
} else {return {}}
} else {return {}}
}
https - http {
set hs [::http::geturl $url -binary 1 -keepalive 1 -timeout 5000]
return [::http::data $hs]
}
default {return {}}
}
}
# file read helper
proc readfile {fname} {
set fp [open $fname r]
fconfigure $fp -encoding utf-8
set data [read $fp]
close $fp
return $data
}
# file write helper (leaves a newline at the end)
proc writefileln {fname data} {
set fp [open $fname w]
fconfigure $fp -encoding utf-8
puts $fp $data
close $fp
}
# main logic proc
proc fetchiidb {url echos dbdir dolog} {
# trim the parameters
set url [string trim $url]
set echos [string trim $echos]
set dbdir [file normalize [string trim $dbdir]]
set echodir [file join $dbdir "echo"]
set msgdir [file join $dbdir "msg"]
# ensure that the necessary dirs exist
file mkdir $dbdir $echodir $msgdir
# attempt to fetch the echolist if echos are empty
if {$echos eq {}} {
if {$dolog eq 1} {puts "Fetching echolist..."}
set echolist [getfile "$url/list.txt"]
set echos [lmap e [split $echolist "\n"] {lindex [split $e ":"] 0}]
} else {
set echos [split $echos "/,;"]
}
if {$dolog eq 1} {puts "Echos to fetch: $echos"}
# pass the echo list and fetch the message IDs
set echos [lmap s $echos {string trim $s}]
set echodata [getfile [string cat $url "/u/e/" [join $echos "/"]]]
# iterate over the fetched data and fetch corresponding messages
set curecho ""
set datalines [split $echodata "\n"]
set echomap ""
# build the map of lists of message IDs
foreach line $datalines {
set line [string trim $line]
# detect if the line is related to echo name or message ID
if {[string first "." $line] eq -1} { # message ID
if {$curecho ne ""} {
dict lappend echomap $curecho $line
}
} else { # echo name
set curecho $line
dict set echomap $curecho ""
}
}
if {$dolog eq 1} {puts "Echomap built"}
# detect how many message IDs we can pass in a single query
# (assuming the maximum GET length is 256 chars)
# then we assume 21 character per message ID
set maxids [expr {int(256 / 21)}]
# pass the echo list and fetch the message IDs
# now, process the map we've built
dict for {echoname msgids} $echomap {
# get the existing message IDs in the echo
set echofile [file join $echodir $echoname]
set oldmsgids ""
if [file exists $echofile] {
set oldmsgids [lmap s [split [readfile $echofile] "\n"] {string trim $s}]
}
# pre-filter the new message IDs to fetch
set newmsgids [lmap m [concat $oldmsgids $msgids] {
if {$m in $oldmsgids && $m in $msgids} continue
if {$m eq {}} continue
set m
}]
# save the echo index file with all message IDs
writefileln $echofile [join $msgids "\n"]
if {$dolog eq 1} {puts "Fetching [llength $newmsgids] new messages from $echoname, $maxids messages per request..."}
set idgroups ""
set grcount 0
set localcount 0
foreach nmid $newmsgids { # iterate over new messages to group them
if {$nmid ne ""} {
dict lappend idgroups $grcount $nmid
incr localcount
if {$localcount > $maxids} {
incr grcount
set localcount 0
}
}
}
dict for {mgrpind mgrp} $idgroups { # iterate over groups to fetch the messages
# get the message data in the bundle format
set msgbundle [getfile [string cat $url "/u/m/" [join $mgrp "/"]]]
set bdata [split $msgbundle "\n"]
foreach bline $bdata {
set parts [split $bline ":"]
if {[llength $parts] > 1} { # valid message
set mid [lindex $parts 0]
set mdata [binary decode base64 [lindex $parts 1]]
writefileln [file join $msgdir $mid] [encoding convertfrom utf-8 $mdata]
}
}
}
}
}
# 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-tiifetch $appdir] {
set appdir [file normalize [file join $appdir ".." ".." ".." ]]
}
if {$argc > 0} {
set localdbdir [file join $appdir "tiidb"]
if {$argc > 2} {
set localdbdir [lindex $argv 2]
}
puts "Fetching messages, please wait..."
fetchiidb [lindex $argv 0] [lindex $argv 1] $localdbdir 1
puts "Messages fetched"
} else {puts "No ii/idec station URL specified!"}