~aleteoryx/tclfeed-bsky

b412dbd9bef8091f139642f647b66b4f02974529 — Aleteoryx 29 days ago 4071a09
publisher
3 files changed, 187 insertions(+), 0 deletions(-)

A bin/up.tcl
A lib/atpagent.tcl
A lib/prompt.tcl
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"
}