A bin/up.tcl => bin/up.tcl +77 -0
@@ 0,0 1,77 @@
+#!/bin/env tclsh
+# A rough copy of <https://github.com/bluesky-social/feed-generator/blob/main/scripts/publishFeedGen.ts>
+
+package require json
+package require json::write
+package require http
+package require tls
+
+::http::register https 443 ::tls::socket
+
+cd [file dirname [file dirname [dict get [info frame [info frame]] file]]]
+
+source lib/prompt.tcl
+source lib/atpagent.tcl
+
+input "Enter your bsky handle:" conf(handle)
+paswd "Enter your Bluesky password (preferably an App Password):" conf(password)
+input "Optionally, enter a custom PDS service to sign in with:" conf(service) https://bsky.social
+input "Enter the host where the feed is available:" conf(feedHost)
+input "Enter a short name or the record. This will be shown in the feed's URL:" conf(recordName)
+input "Enter a display name for your feed:" conf(displayName)
+inopt "Optionally, enter a brief description of your feed:" conf(description)
+inopt "Optionally, enter a local path to an avatar that will be used for the feed:" conf(avatar)
+
+atpagent agent $conf(service)
+
+agent login $conf(handle) $conf(password)
+
+if {$conf(description) == ""} {
+ set description null
+} else {
+ set description [::json::write string $conf(description)]
+}
+
+set avatarRef {}
+if {$conf(avatar) != {}} {
+ switch -glob -- $conf(avatar) {
+ *.png {
+ set mime image/png
+ }
+ *.{jpg,jpeg} {
+ set mime image/jpeg
+ }
+ default {
+ return -code error "expected png or jpeg avatar"
+ }
+ }
+
+ set fd [open $conf(avatar) r]
+ fconfigure $fd -translation binary
+ set avatar [read $fd]
+ close $fd
+ unset fd
+
+ lassign [agent xrpc com.atproto.repo.uploadBlob -type $mime $avatar] av_ncode av_data
+ puts "upload: $av_data"
+ if {$av_ncode != 200} { return -code error "got $av_ncode uploading avatar!\n$av_data" }
+
+ set avatarRef [list avatar [::json::write string $av_data]]
+
+ puts $avatarRef
+}
+
+lassign [agent xrpc com.atproto.repo.putRecord \
+ repo [::json::write string [agent state did]] \
+ collection {"app.bsky.feed.generator"} \
+ rkey [::json::write string $conf(recordName)] \
+ record [::json::write object \
+ did [::json::write string did:web:$conf(feedHost)] \
+ displayName [::json::write string $conf(displayName)] \
+ description $description \
+ createdAt [::json::write string [clock format [clock seconds] -format "%Y-%m-%dT%T.000Z"]] \
+ {*}$avatarRef]] pr_ncode pr_data
+
+if {$pr_ncode != 200} { return -code error "got $pr_ncode putting feed record!\n$pr_data" }
+
+puts "All done 🎉"
A lib/atpagent.tcl => lib/atpagent.tcl +74 -0
@@ 0,0 1,74 @@
+proc atpagent {procname service} {
+ global atp_state
+ upvar 0 atp_state($procname) state
+
+ dict set state service $service
+ dict set state session 0
+ proc $procname {cmd args} [concat uplevel {[list } ::atpagent_inner [list $procname] {$cmd $args ]} ]
+}
+
+proc atpagent_inner {statename cmd argv} {
+ global atp_state
+ upvar 0 atp_state($statename) state
+
+ switch -- $cmd {
+ login {
+ lassign $argv username password
+
+ lassign [$statename xrpc com.atproto.server.createSession \
+ identifier [::json::write string $username] \
+ password [::json::write string $password]] ncode data
+
+ if {$ncode != 200} {
+ return -code error "code $ncode from [dict get $state service]!\n$data]"
+ }
+
+ dict set state session 1
+ dict set state jwt [dict get $data accessJwt]
+ dict set state handle [dict get $data handle]
+ dict set state did [dict get $data did]
+ }
+ xrpc {
+ set rest [lassign $argv endpoint]
+
+ set headers {}
+ if [dict get $state session] {dict set headers Authorization "Bearer [dict get $state jwt]"}
+
+ if {[llength $rest] == 0} {
+ # GET path
+
+ set http_state [http::geturl \
+ [dict get $state service]/xrpc/$endpoint \
+ -headers $headers]
+
+ set ncode [::http::ncode $http_state]
+ set data [::json::json2dict [::http::data $http_state]]
+ return [list $ncode $data]
+ }
+
+ # POST path
+
+ set mime "application/json"
+ if {[lindex $rest 0] == "-type"} {
+ set rest [lasign $rest _ mime]
+ }
+
+ if {[llength $rest] > 1 && $mime == "application/json"} {
+ set rest [::json::write object {*}$rest]
+ }
+
+ set http_state [http::geturl \
+ [dict get $state service]/xrpc/$endpoint \
+ -headers $headers \
+ -query $rest \
+ -type $mime]
+
+ set ncode [::http::ncode $http_state]
+ set data [::json::json2dict [::http::data $http_state]]
+ return [list $ncode $data]
+ }
+ state {
+ dict get $state {*}$argv
+ }
+ }
+}
A lib/prompt.tcl => lib/prompt.tcl +36 -0
@@ 0,0 1,36 @@
+proc input {message varname {default {}}} {
+ upvar $varname input
+ set input {}
+ puts $message
+ while {$input == {}} {
+ puts -nonewline "% "
+ flush stdout
+ gets stdin input
+ if {$input == {}} {set input $default}
+ }
+ puts ""
+}
+
+proc inopt {message varname} {
+ upvar $varname input
+ set input {}
+ puts $message
+ puts -nonewline "% "
+ flush stdout
+ gets stdin input
+ puts ""
+}
+
+proc paswd {message varname} {
+ upvar $varname input
+ set input {}
+ puts $message
+ exec stty -echo
+ while {$input == {}} {
+ puts -nonewline "% "
+ flush stdout
+ gets stdin input
+ }
+ exec stty echo
+ puts "\n"
+}