cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-16 08:00:35 +01:00
Code Issues

- gemini client works (but missing client authorization using certificates).

Browse Source
This commit is contained in:
cage 2020-06-22 13:58:04 +02:00
parent ffdd960673
commit 9461c0ea70
31 changed files with 1020 additions and 278 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
LICENSES.org
View File

@ -286,3 +286,38 @@
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
- src/x509.lisp
derived from cl+ssl
Copyright (C) 2001, 2003 Eric Marsden
Copyright (C) ???? Jochen Schmidt
Copyright (C) 2005 David Lichteblau
Copyright (C) 2007 Pixel // pinterface
- License first changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
from plain LGPL to Lisp-LGPL in December 2005.
- License then changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
from Lisp-LGPL to MIT-style in January 2007.
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation files
(the "Software"), to deal in the Software without restriction,
including without limitation the rights to use, copy, modify, merge,
publish, distribute, sublicense, and/or sell copies of the Software,
and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

3
README.org
View File

@ -189,6 +189,9 @@
[[https://beta.quicklisp.org/quicklisp.lisp][quicklisp sources]] for
details.
By default, pressing "!" will contact the remote service located at:
"gemini://houston.coder.town/search".
* Contributing
Any help is appreciated. If you intend to contribute please point

3
README.txt
View File

@ -247,6 +247,9 @@ Table of Contents
<https://www.quicklisp.org/>, check the [quicklisp sources] for
details.
By default, pressing "!" will contact the remote service located at:
"gemini://houston.coder.town/search".
[quicklisp sources] <https://beta.quicklisp.org/quicklisp.lisp>

23
doc/man.org
View File

@ -223,14 +223,23 @@
* Privacy
This program do not interact with no other computer other than the
mastodon instance that the user configured.
The author of this software collects no user data information with
this software.
If installed from the source note that the script
~quick_quicklisp.sh~ will contact [[https://www.quicklisp.org/]],
check the
[[https://beta.quicklisp.org/quicklisp.lisp][quicklisp sources]]
for details.
But this software is a client to connect and interact to one or more
remote computer. So potentially it could share a lot of information
with other actors but just after the user allowed it to do so.
It is the user responsibility to checks the privacy conditions of the
instance this software connect to.
By default, pressing "!" will contact the remote service located at:
"gemini://houston.coder.town/search".
Moreover launching ~quick_quicklisp.sh~ will contact
[[https://www.quicklisp.org/]], check the
[[https://beta.quicklisp.org/quicklisp.lisp][quicklisp sources]] for
details.
* Acknowledgment

26
doc/tinmop.man
View File

@ -291,15 +291,27 @@ in the directory \fC$HOME/.local/share/tinmop/\fP.
.SH "Privacy"
.PP
This program do not interact with no other computer other than the
mastodon instance that the user configured.
The author of this software collects no user data information with
this software.
.PP
If installed from the source note that the script
\fCquick_quicklisp.sh\fP will contact \fIhttps://www.quicklisp.org/\fP,
check the
https://beta.quicklisp.org/quicklisp.lisp \fBat\fP \fIquicklisp sources\fP
for details.
But this software is a client to connect and interact to one or more
remote computer. So potentially it could share a lot of information
with other actors but just after the user allowed it to do so.
.PP
It is the user responsibility to checks the privacy conditions of the
instance this software connect to.
.PP
By default, pressing "!" will contact the remote service located at:
"gemini://houston.coder.town/search".
.PP
Moreover launching \fCquick_quicklisp.sh\fP will contact
\fIhttps://www.quicklisp.org/\fP, check the
https://beta.quicklisp.org/quicklisp.lisp \fBat\fP \fIquicklisp sources\fP for
details.
.SH "Acknowledgment"
.PP

24
etc/init.lisp
View File

@ -25,8 +25,8 @@
;;
;; can not be an anonymous function.
(defun quit () ; define a custom function named 'quit' and no parameters
"Quit the program" ; this string after the function name and parameters is
(defun quit () ; define a custom function named 'quit' and no parameters.
"Quit the program" ; This string after the function name and parameters is
; called 'docstring' and will be presented to the
; user as inline help
(ui:clean-close-program))
@ -120,6 +120,8 @@
;; (define "C-x a e" #'bar)
(defun gemini-search ()
(gemini-viewer:request "gemini://houston.coder.town/search"))
;; global keymap
@ -129,6 +131,8 @@
(define-key "?" #'print-quick-help)
(define-key "!" #'gemini-search)
;; focus
(define-key "f1" #'focus-to-tags-window)
@ -275,6 +279,22 @@
(define-key "ppage" #'message-scroll-previous-page *message-keymap*)
;; gemini viewer keymap
(define-key "up" #'message-scroll-up *gemini-message-keymap*)
(define-key "down" #'message-scroll-down *gemini-message-keymap*)
(define-key "home" #'message-scroll-begin *gemini-message-keymap*)
(define-key "end" #'message-scroll-end *gemini-message-keymap*)
(define-key "/" #'message-search-regex *gemini-message-keymap*)
(define-key "npage" #'message-scroll-next-page *gemini-message-keymap*)
(define-key "ppage" #'message-scroll-previous-page *gemini-message-keymap*)
;; tags keymap
(define-key "up" #'tag-go-up *tags-keymap*)

8
etc/shared.conf
View File

@ -57,10 +57,14 @@ editor = "nano --locking"
# attribute is optional
# Some examples follows
# Some examples follows, order matters!
color-regexp = "http(s)?://[^ ]+" #ff0000
color-regexp = "-> gemini://[^ ]+" yellow underline
color-regexp = "gemini://[^ ]+" #ff0000
color-regexp = "(?i)(\\(c\\))|(\\(r\\))" #ff0000 bold
color-regexp = "[0-9]{4}-[0-9]?[0-9]-[0-9]?[0-9]" #0000ff bold
@ -77,6 +81,8 @@ color-regexp = "⯀" green bold
color-regexp = "The poll has expired" #ff00ff bold
# you can filter off users using regexp
# ignore-user-regexp = "@domain-name$"

9
po/POTFILES.in
View File

@ -1,5 +1,5 @@
# List of source files which contain translatable strings.
src/api-client.lisp
src/api-pleroma.lisp
src/box.lisp
src/bs-tree.lisp
src/command-line.lisp
@ -7,6 +7,8 @@ src/command-window.lisp
src/complete-window.lisp
src/complete.lisp
src/conditions.lisp
src/config.lisp
src/config.lisp.in
src/constants.lisp
src/conversations-window.lisp
src/crypto-utils.lisp
@ -16,6 +18,11 @@ src/db.lisp
src/emoji-shortcodes.lisp
src/filesystem-utils.lisp
src/follow-requests.lisp
src/gemini-viewer.lisp
src/gemini/client.lisp
src/gemini/gemini-constants.lisp
src/gemini/gemini-parser.lisp
src/gemini/package.lisp
src/hooks.lisp
src/html-utils.lisp
src/interfaces.lisp

249
po/it.po
View File

@ -8,8 +8,8 @@ msgid ""
msgstr ""
"Project-Id-Version: tinmop 0.0.1\n"
"Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
"POT-Creation-Date: 2020-06-07 12:11+0200\n"
"PO-Revision-Date: 2020-06-07 12:15+0200\n"
"POT-Creation-Date: 2020-06-22 13:11+0200\n"
"PO-Revision-Date: 2020-06-22 13:12+0200\n"
"Last-Translator: cage <cage@invalid.org>\n"
"Language-Team: Italian\n"
"Language: it\n"
@ -68,7 +68,7 @@ msgstr ""
"Errore: non sono stato in grado di creare il socket per la cattura del "
"codice di autorizzazione."
#: src/api-client.lisp:755
#: src/api-client.lisp:782
#, lisp-format
msgid "Initializing empty credentials file in ~a"
msgstr "Inizializzo credenziali vuote (segnaposto) nel file ~a"
@ -131,7 +131,7 @@ msgstr "Notifica i messaggi che menzionano l'utente."
msgid "Error: command ~a not found"
msgstr "Errore: comando ~a non trovato"
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2356
#: src/conditions.lisp:70 src/conditions.lisp:74 src/db.lisp:2432
#: src/message-rendering-utils.lisp:132 src/message-rendering-utils.lisp:166
#: src/message-rendering-utils.lisp:171
msgid "unknown"
@ -141,19 +141,19 @@ msgstr "sconosciuto"
msgid "Conversations"
msgstr "Conversazioni"
#: src/db.lisp:170
#: src/db.lisp:176
msgid "federated"
msgstr "federata"
#: src/db.lisp:172
#: src/db.lisp:178
msgid "local"
msgstr "locale"
#: src/db.lisp:174
#: src/db.lisp:180
msgid "direct"
msgstr "diretta"
#: src/db.lisp:176
#: src/db.lisp:182
msgid "home"
msgstr "home"
@ -166,43 +166,86 @@ msgstr ""
"cancelli un elemento la corrispondente richiesta sarà scartata altrimenti "
"verrà accettata."
#: src/gemini-viewer.lisp:24
#, lisp-format
msgid "Could not understand the address ~s"
msgstr "Non riesco ad interpretare l'indirizzo: ~s"
#: src/gemini-viewer.lisp:52
#, lisp-format
msgid "Redirects to ~s, follows redirect? [y/N] "
msgstr "Seguire la redirezione a ~s? [s/N] "
#: src/gemini-viewer.lisp:65
#, lisp-format
msgid "Server ~s asks: ~s "
msgstr "Il server ~s chiede: ~s "
#: src/gemini-viewer.lisp:85
#, lisp-format
msgid "Error getting ~s: ~a"
msgstr "Errore connettendomi a ~s: ~a"
#: src/gemini-viewer.lisp:87 src/tui-utils.lisp:478
#, lisp-format
msgid "Error: ~a"
msgstr "Errore: ~a"
#: src/gemini/client.lisp:155
#, lisp-format
msgid "The server responded with the error ~a: ~a"
msgstr "Il server ha risposto con l'errore ~a: ~a"
#: src/gemini/client.lisp:166
#, lisp-format
msgid "The certificate of host ~a has changed from your latest visit."
msgstr "Il certificato dell'host ~a è cambiato dall'ultima visita."
#: src/gemini/client.lisp:208
msgid ""
"The server requested a certificate but client validation is not implemented "
"by this program"
msgstr ""
"Il server ha richiesto un certificato ma questa funzionalità non è stata "
"ancora implementata."
#: src/html-utils.lisp:104
msgid "No address found"
msgstr "nessun indirizzo trovato"
#: src/keybindings.lisp:399
#: src/keybindings.lisp:406
msgid "Enter"
msgstr "Invio"
#: src/keybindings.lisp:401
#: src/keybindings.lisp:408
msgid "Delete"
msgstr "Canc"
#: src/keybindings.lisp:403
#: src/keybindings.lisp:410
msgid "Page-up"
msgstr "Pagina-su"
#: src/keybindings.lisp:405
#: src/keybindings.lisp:412
msgid "Page-down"
msgstr "Pagina-giù"
#: src/keybindings.lisp:461
#: src/keybindings.lisp:468
msgid "No documentation available, you can help! :-)"
msgstr "Nessuna documentazione disponbile, aiutaci! :-)"
#: src/keybindings.lisp:493
#: src/keybindings.lisp:500
msgid "Focused window keys"
msgstr "Tasti finestra attiva"
#: src/keybindings.lisp:494
#: src/keybindings.lisp:501
msgid "Global keys"
msgstr "Mappa tasti globale"
#: src/keybindings.lisp:510
#: src/keybindings.lisp:517
msgid "Quick help"
msgstr "Aiuto rapido"
#: src/line-oriented-window.lisp:271 src/ui-goodies.lisp:74
#: src/line-oriented-window.lisp:287 src/ui-goodies.lisp:74
#: src/ui-goodies.lisp:91
msgid "Information"
msgstr "Informazione"
@ -295,7 +338,7 @@ msgstr "È ammessa una sola scelta"
msgid "The poll has expired"
msgstr "Il sondaggio è scaduto"
#: src/message-window.lisp:218
#: src/message-window.lisp:226
msgid "Messages"
msgstr "Messaggi"
@ -311,14 +354,14 @@ msgstr ""
"Errore non rimediabile: file ~a non trovato in nessuna dellle seguenti "
"directory: ~a ~a ~a ~a"
#: src/notify-window.lisp:63
#: src/notify-window.lisp:70
#, lisp-format
msgid "~a pending"
msgid_plural "~a pending"
msgstr[0] "~a in attesa"
msgstr[1] "Altre ~a in attesa"
#: src/open-message-link-window.lisp:57
#: src/open-message-link-window.lisp:57 src/open-message-link-window.lisp:138
msgid "Links"
msgstr "Links"
@ -330,20 +373,20 @@ msgstr ""
"Nessun editor trovato, per favore configura la direttiva 'editor' nel tuo "
"file di configurazione."
#: src/program-events.lisp:418
#: src/program-events.lisp:469
msgid "No message selected!"
msgstr "Nessun messaggio selezionato!"
#: src/program-events.lisp:568
#: src/program-events.lisp:619
msgid "Message sent."
msgstr "Messaggio spedito"
#: src/program-events.lisp:623
#: src/program-events.lisp:674
#, lisp-format
msgid "Downloaded new messages for tag ~a"
msgstr "Scaricati nuovi messaggi per l'etichetta ~a."
#: src/program-events.lisp:735
#: src/program-events.lisp:786
#, lisp-format
msgid "Got ~a notification"
msgid_plural "Got ~a notifications"
@ -376,7 +419,7 @@ msgstr "Oggetto del messaggio: "
msgid "Visibility:"
msgstr "Visibilità:"
#: src/software-configuration.lisp:429
#: src/software-configuration.lisp:445
msgid "This message was crypted."
msgstr "Questo messaggion era cifrato."
@ -389,50 +432,50 @@ msgstr "Pagina ~a di ~a"
msgid "Subscribed tags"
msgstr "Sottoscrizioni"
#: src/text-utils.lisp:456
#: src/text-utils.lisp:476
#, lisp-format
msgid "Can not fit column of width of ~a in a box of width ~a"
msgstr ""
"Non posso adattare una colonna di larghezza ~a in una scatola di larghezza ~a"
#: src/text-utils.lisp:570
#: src/text-utils.lisp:590
#, lisp-format
msgid "Unrecoverable error: ~a can not be fitted in a box of width ~a"
msgstr ""
"Errore non rimediabile: ~a non può adattarsi ad una scatola di larghezza ~a"
#: src/thread-window.lisp:134
#: src/thread-window.lisp:142
msgid "no timeline selected"
msgstr "Nessuna timeline selezionata"
#: src/thread-window.lisp:142
#: src/thread-window.lisp:150
msgid "no folder selected"
msgstr "Nessuna cartella selezionata"
#: src/thread-window.lisp:397
#: src/thread-window.lisp:406
msgid "Missing subject"
msgstr "Oggetto mancante"
#: src/thread-window.lisp:729
#: src/thread-window.lisp:754
#, lisp-format
msgid "No message with index ~a exists."
msgstr "Nessun messaggio esiste alla posizione ~a."
#: src/thread-window.lisp:859 src/thread-window.lisp:893
#: src/thread-window.lisp:884 src/thread-window.lisp:918
#, lisp-format
msgid "No next message that contains ~s exists."
msgstr "Nessun messaggio successivo che contenga ~s esiste."
#: src/thread-window.lisp:865 src/thread-window.lisp:899
#: src/thread-window.lisp:890 src/thread-window.lisp:924
#, lisp-format
msgid "No previous message that contains ~s exists."
msgstr "Nessun messaggio precedente che contenga ~s esiste."
#: src/thread-window.lisp:915
#: src/thread-window.lisp:940
msgid "No others unread messages exist."
msgstr "Non ci sono altri messaggi non letti."
#: src/thread-window.lisp:926
#: src/thread-window.lisp:951
msgid "Threads"
msgstr "Discussioni"
@ -441,11 +484,6 @@ msgstr "Discussioni"
msgid "Unknown event ~a"
msgstr "Evento sconosciuto ~a"
#: src/tui-utils.lisp:477
#, lisp-format
msgid "Error: ~a"
msgstr "Errore: ~a"
#: src/ui-goodies.lisp:21
msgid "y"
msgstr "s"
@ -566,286 +604,286 @@ msgstr "Questa timeline è protetta."
msgid "Change timeline: "
msgstr "Spostati nella timeline: "
#: src/ui-goodies.lisp:529 src/ui-goodies.lisp:552
#: src/ui-goodies.lisp:531 src/ui-goodies.lisp:556
msgid "Downloading messages."
msgstr "Scarico i messaggi."
#: src/ui-goodies.lisp:530 src/ui-goodies.lisp:553 src/ui-goodies.lisp:593
#: src/ui-goodies.lisp:532 src/ui-goodies.lisp:557 src/ui-goodies.lisp:599
msgid "Messages downloaded."
msgstr "Messaggi scaricati"
#: src/ui-goodies.lisp:570
#: src/ui-goodies.lisp:578
msgid "Expanding thread"
msgstr "Espandi l'albero dei messaggi"
#: src/ui-goodies.lisp:592
#: src/ui-goodies.lisp:598
msgid "Downloading tags messages."
msgstr "Scarico i messaggi dell'etichetta."
#: src/ui-goodies.lisp:605
#: src/ui-goodies.lisp:611
msgid "Favorite this message?"
msgstr "Conservare tra i favoriti questo messaggio?"
#: src/ui-goodies.lisp:614
#: src/ui-goodies.lisp:620
msgid "Favouring message."
msgstr "Conservo il messaggio tra i favoriti."
#: src/ui-goodies.lisp:615
#: src/ui-goodies.lisp:621
msgid "Favoured message."
msgstr "Messaggio conservato tra i favoriti."
#: src/ui-goodies.lisp:620
#: src/ui-goodies.lisp:626
msgid "Remove this message from your favourites?"
msgstr "Rimuovere dai preferiti questo messaggio?"
#: src/ui-goodies.lisp:629
#: src/ui-goodies.lisp:635
msgid "Unfavouring message."
msgstr "Rimuovo messaggio dai favoriti."
#: src/ui-goodies.lisp:630
#: src/ui-goodies.lisp:636
msgid "Unfavoured message."
msgstr "Rimuosso messaggio dai favoriti."
#: src/ui-goodies.lisp:635
#: src/ui-goodies.lisp:641
msgid "Boost this message?"
msgstr "Rilancia questo messaggio?"
#: src/ui-goodies.lisp:644
#: src/ui-goodies.lisp:650
msgid "Boosting message."
msgstr "Rilancio il messaggio."
#: src/ui-goodies.lisp:645
#: src/ui-goodies.lisp:651
msgid "Boosted message."
msgstr "Messaggio rilanciato."
#: src/ui-goodies.lisp:650
#: src/ui-goodies.lisp:656
msgid "Unboost this message?"
msgstr "Ritira il rilancio del messaggio?"
#: src/ui-goodies.lisp:659
#: src/ui-goodies.lisp:665
msgid "Uboosting message."
msgstr "Ritiro il rilancio del messaggio."
#: src/ui-goodies.lisp:660
#: src/ui-goodies.lisp:666
msgid "Unboosted message."
msgstr "Ritirato il rilancio del messaggio."
#: src/ui-goodies.lisp:668
#: src/ui-goodies.lisp:674
#, lisp-format
msgid "Ignore ~s?"
msgstr "Ignorare ~s?"
#: src/ui-goodies.lisp:671
#: src/ui-goodies.lisp:677
#, lisp-format
msgid "Ignoring ~s"
msgstr "Ignoro ~s"
#: src/ui-goodies.lisp:672
#: src/ui-goodies.lisp:678
#, lisp-format
msgid "User ~s ignored"
msgstr "Utente ~s ignorato"
#: src/ui-goodies.lisp:682
#: src/ui-goodies.lisp:688
msgid "No username specified."
msgstr "Nessun nome utente indicato."
#: src/ui-goodies.lisp:684
#: src/ui-goodies.lisp:690
msgid "Unignore username: "
msgstr "Riprendere a leggere i messaggi di:"
#: src/ui-goodies.lisp:713
#: src/ui-goodies.lisp:719
#, lisp-format
msgid "File ~s does not exists."
msgstr "Il file ~s non esiste."
#: src/ui-goodies.lisp:715
#: src/ui-goodies.lisp:721
msgid "Message ready to be sent"
msgstr "Messaggio pronto per essere spedito"
#: src/ui-goodies.lisp:717
#: src/ui-goodies.lisp:723
msgid "Add attachment: "
msgstr "Aggiungi allegato: "
#: src/ui-goodies.lisp:727
#: src/ui-goodies.lisp:733
msgid "New subject: "
msgstr "Nuovo oggetto del messaggio: "
#: src/ui-goodies.lisp:736
#: src/ui-goodies.lisp:742
msgid "New visibility: "
msgstr "Nuovo livello di visibilità: "
#: src/ui-goodies.lisp:783
#: src/ui-goodies.lisp:789
#, lisp-format
msgid "Your message is ~a character too long."
msgid_plural "Your message is ~a characters too long."
msgstr[0] "Il tuo messaggio e più lungo del limite ammesso di ~a carattere."
msgstr[1] "Il tuo messaggio e più lungo del limite ammesso di ~a caratteri."
#: src/ui-goodies.lisp:807
#: src/ui-goodies.lisp:813
msgid "Add subject: "
msgstr "Oggetto del messaggio: "
#: src/ui-goodies.lisp:866
#: src/ui-goodies.lisp:872
#, lisp-format
msgid "The maximum allowed number of media is ~a."
msgstr "Il numero massimo di file da allegare è ~a."
#: src/ui-goodies.lisp:869
#: src/ui-goodies.lisp:875
msgid "Sending message"
msgstr "Spedisco il messaggio"
#: src/ui-goodies.lisp:947
#: src/ui-goodies.lisp:962
msgid "Follow: "
msgstr "Segui: "
#: src/ui-goodies.lisp:950
#: src/ui-goodies.lisp:965
#, lisp-format
msgid "Following ~a"
msgstr "Segui ~a"
#: src/ui-goodies.lisp:951
#: src/ui-goodies.lisp:966
#, lisp-format
msgid "Followed ~a"
msgstr "Adesso segui ~a "
#: src/ui-goodies.lisp:955
#: src/ui-goodies.lisp:970
msgid "Unfollow: "
msgstr "Abbandona: "
#: src/ui-goodies.lisp:958
#: src/ui-goodies.lisp:973
#, lisp-format
msgid "Unfollowing ~a"
msgstr "Abbandona ~a"
#: src/ui-goodies.lisp:959
#: src/ui-goodies.lisp:974
#, lisp-format
msgid "Unfollowed ~a"
msgstr "Hai abbandonato ~a"
#: src/ui-goodies.lisp:988
#: src/ui-goodies.lisp:1003
msgid "Confirm operation?"
msgstr "Confermi l'operazione?"
#: src/ui-goodies.lisp:1026
#: src/ui-goodies.lisp:1041
msgid "Updating conversations."
msgstr "Aggiorno le conversazioni"
#: src/ui-goodies.lisp:1027
#: src/ui-goodies.lisp:1042
msgid "Conversations updated."
msgstr "Conversazioni aggiornate"
#: src/ui-goodies.lisp:1037
#: src/ui-goodies.lisp:1052
msgid "Open conversation: "
msgstr "Apri una conversazione: "
#: src/ui-goodies.lisp:1072
#: src/ui-goodies.lisp:1087
msgid "Old name: "
msgstr "Nome precedente: "
#: src/ui-goodies.lisp:1086
#: src/ui-goodies.lisp:1101
#, lisp-format
msgid "A conversation with name ~a already exists."
msgstr "Una conversazione con nome ~a esiste già."
#: src/ui-goodies.lisp:1092
#: src/ui-goodies.lisp:1107
msgid "New name: "
msgstr "Nuovo nome: "
#: src/ui-goodies.lisp:1108
#: src/ui-goodies.lisp:1123
#, lisp-format
msgid "Ignore conversation ~s? [y/N] "
msgstr "Ignorare la conversazione ~s? [s/N] "
#: src/ui-goodies.lisp:1124
#: src/ui-goodies.lisp:1139
#, lisp-format
msgid "Delete conversation ~s? [y/N] "
msgstr "Eliminare la conversazione ~s? [s/N] "
#: src/ui-goodies.lisp:1143
#: src/ui-goodies.lisp:1158
#, lisp-format
msgid "Comment too long by ~a character"
msgid_plural "Comment too long by ~a characters"
msgstr[0] "Il commento è troppo lungo di ~a caratteri"
msgstr[1] "Il commento è troppo lungo di ~a caratteri"
#: src/ui-goodies.lisp:1150
#: src/ui-goodies.lisp:1165
#, lisp-format
msgid "Reporting user: ~s"
msgstr "Segnalo l'utente ~s"
#: src/ui-goodies.lisp:1151
#: src/ui-goodies.lisp:1166
msgid "Report trasmitted."
msgstr "Segnalazione trasmessa."
#: src/ui-goodies.lisp:1154
#: src/ui-goodies.lisp:1169
msgid "Comment on reports: "
msgstr "Commento sulla segnalazione: "
#: src/ui-goodies.lisp:1170 src/ui-goodies.lisp:1203 src/ui-goodies.lisp:1221
#: src/ui-goodies.lisp:1185 src/ui-goodies.lisp:1218 src/ui-goodies.lisp:1236
#, lisp-format
msgid "User ~s does not exists in database"
msgstr "L'utente ~s non esiste nel database"
#: src/ui-goodies.lisp:1173 src/ui-goodies.lisp:1206 src/ui-goodies.lisp:1224
#: src/ui-goodies.lisp:1188 src/ui-goodies.lisp:1221 src/ui-goodies.lisp:1239
msgid "Username: "
msgstr "Nome utente: "
#: src/ui-goodies.lisp:1183
#: src/ui-goodies.lisp:1198
#, lisp-format
msgid "Added crypto key for user ~s"
msgstr "Aggiunta chiave crittografica per l'utente ~s"
#: src/ui-goodies.lisp:1186
#: src/ui-goodies.lisp:1201
msgid "Key: "
msgstr "Chiave: "
#: src/ui-goodies.lisp:1200
#: src/ui-goodies.lisp:1215
#, lisp-format
msgid "Generated key for user ~s"
msgstr "Generata chiave crittografica per l'utente ~s"
#: src/ui-goodies.lisp:1201
#: src/ui-goodies.lisp:1216
#, lisp-format
msgid "user ~s key ~s"
msgstr "utente ~s chiave ~s"
#: src/ui-goodies.lisp:1217
#: src/ui-goodies.lisp:1232
#, lisp-format
msgid "Added key for user ~s: ~a"
msgstr "Aggiunta chiave crittografica per l'utente ~s: ~a"
#: src/ui-goodies.lisp:1234
#: src/ui-goodies.lisp:1249
msgid "About this software"
msgstr "Sul programma"
#: src/ui-goodies.lisp:1246
#: src/ui-goodies.lisp:1261
msgid "Clearing pagination data"
msgstr "Elimina i dati della paginazione"
#: src/ui-goodies.lisp:1265
#: src/ui-goodies.lisp:1280
msgid "Invalid choices, usa a space separated list of positive integers."
msgstr ""
"Il formato ammesso è costituito da una lista di interi positivi separati da "
"spazi."
#: src/ui-goodies.lisp:1282
#: src/ui-goodies.lisp:1297
#, lisp-format
msgid "Invalid choices, index choice out of range (max ~a)."
msgstr "Intervallo dei valori delle scelte non valido (massimo ~a)."
#: src/ui-goodies.lisp:1284
#: src/ui-goodies.lisp:1299
msgid "Voting... "
msgstr "Votazione in corso..."
#: src/ui-goodies.lisp:1285
#: src/ui-goodies.lisp:1300
msgid "Choice sent."
msgstr "Voto inserito."
#: src/ui-goodies.lisp:1294
#: src/ui-goodies.lisp:1309
msgid "Type the index (or space separated indices) of selected choices: "
msgstr "Inserisci gli indici associati alle opzioni separati da spazi: "
#: src/ui-goodies.lisp:1295
#: src/ui-goodies.lisp:1310
msgid "This in not a poll"
msgstr "Questo messaggio non è un sondaggio."
@ -853,6 +891,9 @@ msgstr "Questo messaggio non è un sondaggio."
msgid "OK"
msgstr "OK"
#~ msgid "Error: a~%"
#~ msgstr "Errore: ~a~%"
#~ msgid "The list is too big to be displayed entirely"
#~ msgstr "La lista è troppo lunga per essere mostrata interamente"

244
po/tinmop.pot
View File

@ -6,9 +6,9 @@
#, fuzzy
msgid ""
msgstr ""
"Project-Id-Version: tinmop 0.0.3\n"
"Project-Id-Version: tinmop 0.0.7\n"
"Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
"POT-Creation-Date: 2020-06-07 12:11+0200\n"
"POT-Creation-Date: 2020-06-22 13:11+0200\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
@ -64,7 +64,7 @@ msgid ""
"Error: was not able to create server socket to listen for authorization code"
msgstr ""
#: src/api-client.lisp:755
#: src/api-client.lisp:782
#, lisp-format
msgid "Initializing empty credentials file in ~a"
msgstr ""
@ -127,7 +127,7 @@ msgstr ""
msgid "Error: command ~a not found"
msgstr ""
#: src/conditions.lisp:67 src/conditions.lisp:71 src/db.lisp:2356
#: src/conditions.lisp:70 src/conditions.lisp:74 src/db.lisp:2432
#: src/message-rendering-utils.lisp:132 src/message-rendering-utils.lisp:166
#: src/message-rendering-utils.lisp:171
msgid "unknown"
@ -137,19 +137,19 @@ msgstr ""
msgid "Conversations"
msgstr ""
#: src/db.lisp:170
#: src/db.lisp:176
msgid "federated"
msgstr ""
#: src/db.lisp:172
#: src/db.lisp:178
msgid "local"
msgstr ""
#: src/db.lisp:174
#: src/db.lisp:180
msgid "direct"
msgstr ""
#: src/db.lisp:176
#: src/db.lisp:182
msgid "home"
msgstr ""
@ -159,43 +159,84 @@ msgid ""
"accepted, deleted ones will be rejected:"
msgstr ""
#: src/gemini-viewer.lisp:24
#, lisp-format
msgid "Could not understand the address ~s"
msgstr ""
#: src/gemini-viewer.lisp:52
#, lisp-format
msgid "Redirects to ~s, follows redirect? [y/N] "
msgstr ""
#: src/gemini-viewer.lisp:65
#, lisp-format
msgid "Server ~s asks: ~s "
msgstr ""
#: src/gemini-viewer.lisp:85
#, lisp-format
msgid "Error getting ~s: ~a"
msgstr ""
#: src/gemini-viewer.lisp:87 src/tui-utils.lisp:478
#, lisp-format
msgid "Error: ~a"
msgstr ""
#: src/gemini/client.lisp:155
#, lisp-format
msgid "The server responded with the error ~a: ~a"
msgstr ""
#: src/gemini/client.lisp:166
#, lisp-format
msgid "The certificate of host ~a has changed from your latest visit."
msgstr ""
#: src/gemini/client.lisp:208
msgid ""
"The server requested a certificate but client validation is not implemented "
"by this program"
msgstr ""
#: src/html-utils.lisp:104
msgid "No address found"
msgstr ""
#: src/keybindings.lisp:399
#: src/keybindings.lisp:406
msgid "Enter"
msgstr ""
#: src/keybindings.lisp:401
#: src/keybindings.lisp:408
msgid "Delete"
msgstr ""
#: src/keybindings.lisp:403
#: src/keybindings.lisp:410
msgid "Page-up"
msgstr ""
#: src/keybindings.lisp:405
#: src/keybindings.lisp:412
msgid "Page-down"
msgstr ""
#: src/keybindings.lisp:461
#: src/keybindings.lisp:468
msgid "No documentation available, you can help! :-)"
msgstr ""
#: src/keybindings.lisp:493
#: src/keybindings.lisp:500
msgid "Focused window keys"
msgstr ""
#: src/keybindings.lisp:494
#: src/keybindings.lisp:501
msgid "Global keys"
msgstr ""
#: src/keybindings.lisp:510
#: src/keybindings.lisp:517
msgid "Quick help"
msgstr ""
#: src/line-oriented-window.lisp:271 src/ui-goodies.lisp:74
#: src/line-oriented-window.lisp:287 src/ui-goodies.lisp:74
#: src/ui-goodies.lisp:91
msgid "Information"
msgstr ""
@ -288,7 +329,7 @@ msgstr ""
msgid "The poll has expired"
msgstr ""
#: src/message-window.lisp:218
#: src/message-window.lisp:226
msgid "Messages"
msgstr ""
@ -302,14 +343,14 @@ msgid ""
"Unrecoverable error: file ~a not found in any of the directory ~a ~a ~a ~a"
msgstr ""
#: src/notify-window.lisp:63
#: src/notify-window.lisp:70
#, lisp-format
msgid "~a pending"
msgid_plural "~a pending"
msgstr[0] ""
msgstr[1] ""
#: src/open-message-link-window.lisp:57
#: src/open-message-link-window.lisp:57 src/open-message-link-window.lisp:138
msgid "Links"
msgstr ""
@ -319,20 +360,20 @@ msgid ""
"configuration file"
msgstr ""
#: src/program-events.lisp:418
#: src/program-events.lisp:469
msgid "No message selected!"
msgstr ""
#: src/program-events.lisp:568
#: src/program-events.lisp:619
msgid "Message sent."
msgstr ""
#: src/program-events.lisp:623
#: src/program-events.lisp:674
#, lisp-format
msgid "Downloaded new messages for tag ~a"
msgstr ""
#: src/program-events.lisp:735
#: src/program-events.lisp:786
#, lisp-format
msgid "Got ~a notification"
msgid_plural "Got ~a notifications"
@ -365,7 +406,7 @@ msgstr ""
msgid "Visibility:"
msgstr ""
#: src/software-configuration.lisp:429
#: src/software-configuration.lisp:445
msgid "This message was crypted."
msgstr ""
@ -378,48 +419,48 @@ msgstr ""
msgid "Subscribed tags"
msgstr ""
#: src/text-utils.lisp:456
#: src/text-utils.lisp:476
#, lisp-format
msgid "Can not fit column of width of ~a in a box of width ~a"
msgstr ""
#: src/text-utils.lisp:570
#: src/text-utils.lisp:590
#, lisp-format
msgid "Unrecoverable error: ~a can not be fitted in a box of width ~a"
msgstr ""
#: src/thread-window.lisp:134
#: src/thread-window.lisp:142
msgid "no timeline selected"
msgstr ""
#: src/thread-window.lisp:142
#: src/thread-window.lisp:150
msgid "no folder selected"
msgstr ""
#: src/thread-window.lisp:397
#: src/thread-window.lisp:406
msgid "Missing subject"
msgstr ""
#: src/thread-window.lisp:729
#: src/thread-window.lisp:754
#, lisp-format
msgid "No message with index ~a exists."
msgstr ""
#: src/thread-window.lisp:859 src/thread-window.lisp:893
#: src/thread-window.lisp:884 src/thread-window.lisp:918
#, lisp-format
msgid "No next message that contains ~s exists."
msgstr ""
#: src/thread-window.lisp:865 src/thread-window.lisp:899
#: src/thread-window.lisp:890 src/thread-window.lisp:924
#, lisp-format
msgid "No previous message that contains ~s exists."
msgstr ""
#: src/thread-window.lisp:915
#: src/thread-window.lisp:940
msgid "No others unread messages exist."
msgstr ""
#: src/thread-window.lisp:926
#: src/thread-window.lisp:951
msgid "Threads"
msgstr ""
@ -428,11 +469,6 @@ msgstr ""
msgid "Unknown event ~a"
msgstr ""
#: src/tui-utils.lisp:477
#, lisp-format
msgid "Error: ~a"
msgstr ""
#: src/ui-goodies.lisp:21
msgid "y"
msgstr ""
@ -553,284 +589,284 @@ msgstr ""
msgid "Change timeline: "
msgstr ""
#: src/ui-goodies.lisp:529 src/ui-goodies.lisp:552
#: src/ui-goodies.lisp:531 src/ui-goodies.lisp:556
msgid "Downloading messages."
msgstr ""
#: src/ui-goodies.lisp:530 src/ui-goodies.lisp:553 src/ui-goodies.lisp:593
#: src/ui-goodies.lisp:532 src/ui-goodies.lisp:557 src/ui-goodies.lisp:599
msgid "Messages downloaded."
msgstr ""
#: src/ui-goodies.lisp:570
#: src/ui-goodies.lisp:578
msgid "Expanding thread"
msgstr ""
#: src/ui-goodies.lisp:592
#: src/ui-goodies.lisp:598
msgid "Downloading tags messages."
msgstr ""
#: src/ui-goodies.lisp:605
#: src/ui-goodies.lisp:611
msgid "Favorite this message?"
msgstr ""
#: src/ui-goodies.lisp:614
#: src/ui-goodies.lisp:620
msgid "Favouring message."
msgstr ""
#: src/ui-goodies.lisp:615
#: src/ui-goodies.lisp:621
msgid "Favoured message."
msgstr ""
#: src/ui-goodies.lisp:620
#: src/ui-goodies.lisp:626
msgid "Remove this message from your favourites?"
msgstr ""
#: src/ui-goodies.lisp:629
#: src/ui-goodies.lisp:635
msgid "Unfavouring message."
msgstr ""
#: src/ui-goodies.lisp:630
#: src/ui-goodies.lisp:636
msgid "Unfavoured message."
msgstr ""
#: src/ui-goodies.lisp:635
#: src/ui-goodies.lisp:641
msgid "Boost this message?"
msgstr ""
#: src/ui-goodies.lisp:644
#: src/ui-goodies.lisp:650
msgid "Boosting message."
msgstr ""
#: src/ui-goodies.lisp:645
#: src/ui-goodies.lisp:651
msgid "Boosted message."
msgstr ""
#: src/ui-goodies.lisp:650
#: src/ui-goodies.lisp:656
msgid "Unboost this message?"
msgstr ""
#: src/ui-goodies.lisp:659
#: src/ui-goodies.lisp:665
msgid "Uboosting message."
msgstr ""
#: src/ui-goodies.lisp:660
#: src/ui-goodies.lisp:666
msgid "Unboosted message."
msgstr ""
#: src/ui-goodies.lisp:668
#: src/ui-goodies.lisp:674
#, lisp-format
msgid "Ignore ~s?"
msgstr ""
#: src/ui-goodies.lisp:671
#: src/ui-goodies.lisp:677
#, lisp-format
msgid "Ignoring ~s"
msgstr ""
#: src/ui-goodies.lisp:672
#: src/ui-goodies.lisp:678
#, lisp-format
msgid "User ~s ignored"
msgstr ""
#: src/ui-goodies.lisp:682
#: src/ui-goodies.lisp:688
msgid "No username specified."
msgstr ""
#: src/ui-goodies.lisp:684
#: src/ui-goodies.lisp:690
msgid "Unignore username: "
msgstr ""
#: src/ui-goodies.lisp:713
#: src/ui-goodies.lisp:719
#, lisp-format
msgid "File ~s does not exists."
msgstr ""
#: src/ui-goodies.lisp:715
#: src/ui-goodies.lisp:721
msgid "Message ready to be sent"
msgstr ""
#: src/ui-goodies.lisp:717
#: src/ui-goodies.lisp:723
msgid "Add attachment: "
msgstr ""
#: src/ui-goodies.lisp:727
#: src/ui-goodies.lisp:733
msgid "New subject: "
msgstr ""
#: src/ui-goodies.lisp:736
#: src/ui-goodies.lisp:742
msgid "New visibility: "
msgstr ""
#: src/ui-goodies.lisp:783
#: src/ui-goodies.lisp:789
#, lisp-format
msgid "Your message is ~a character too long."
msgid_plural "Your message is ~a characters too long."
msgstr[0] ""
msgstr[1] ""
#: src/ui-goodies.lisp:807
#: src/ui-goodies.lisp:813
msgid "Add subject: "
msgstr ""
#: src/ui-goodies.lisp:866
#: src/ui-goodies.lisp:872
#, lisp-format
msgid "The maximum allowed number of media is ~a."
msgstr ""
#: src/ui-goodies.lisp:869
#: src/ui-goodies.lisp:875
msgid "Sending message"
msgstr ""
#: src/ui-goodies.lisp:947
#: src/ui-goodies.lisp:962
msgid "Follow: "
msgstr ""
#: src/ui-goodies.lisp:950
#: src/ui-goodies.lisp:965
#, lisp-format
msgid "Following ~a"
msgstr ""
#: src/ui-goodies.lisp:951
#: src/ui-goodies.lisp:966
#, lisp-format
msgid "Followed ~a"
msgstr ""
#: src/ui-goodies.lisp:955
#: src/ui-goodies.lisp:970
msgid "Unfollow: "
msgstr ""
#: src/ui-goodies.lisp:958
#: src/ui-goodies.lisp:973
#, lisp-format
msgid "Unfollowing ~a"
msgstr ""
#: src/ui-goodies.lisp:959
#: src/ui-goodies.lisp:974
#, lisp-format
msgid "Unfollowed ~a"
msgstr ""
#: src/ui-goodies.lisp:988
#: src/ui-goodies.lisp:1003
msgid "Confirm operation?"
msgstr ""
#: src/ui-goodies.lisp:1026
#: src/ui-goodies.lisp:1041
msgid "Updating conversations."
msgstr ""
#: src/ui-goodies.lisp:1027
#: src/ui-goodies.lisp:1042
msgid "Conversations updated."
msgstr ""
#: src/ui-goodies.lisp:1037
#: src/ui-goodies.lisp:1052
msgid "Open conversation: "
msgstr ""
#: src/ui-goodies.lisp:1072
#: src/ui-goodies.lisp:1087
msgid "Old name: "
msgstr ""
#: src/ui-goodies.lisp:1086
#: src/ui-goodies.lisp:1101
#, lisp-format
msgid "A conversation with name ~a already exists."
msgstr ""
#: src/ui-goodies.lisp:1092
#: src/ui-goodies.lisp:1107
msgid "New name: "
msgstr ""
#: src/ui-goodies.lisp:1108
#: src/ui-goodies.lisp:1123
#, lisp-format
msgid "Ignore conversation ~s? [y/N] "
msgstr ""
#: src/ui-goodies.lisp:1124
#: src/ui-goodies.lisp:1139
#, lisp-format
msgid "Delete conversation ~s? [y/N] "
msgstr ""
#: src/ui-goodies.lisp:1143
#: src/ui-goodies.lisp:1158
#, lisp-format
msgid "Comment too long by ~a character"
msgid_plural "Comment too long by ~a characters"
msgstr[0] ""
msgstr[1] ""
#: src/ui-goodies.lisp:1150
#: src/ui-goodies.lisp:1165
#, lisp-format
msgid "Reporting user: ~s"
msgstr ""
#: src/ui-goodies.lisp:1151
#: src/ui-goodies.lisp:1166
msgid "Report trasmitted."
msgstr ""
#: src/ui-goodies.lisp:1154
#: src/ui-goodies.lisp:1169
msgid "Comment on reports: "
msgstr ""
#: src/ui-goodies.lisp:1170 src/ui-goodies.lisp:1203 src/ui-goodies.lisp:1221
#: src/ui-goodies.lisp:1185 src/ui-goodies.lisp:1218 src/ui-goodies.lisp:1236
#, lisp-format
msgid "User ~s does not exists in database"
msgstr ""
#: src/ui-goodies.lisp:1173 src/ui-goodies.lisp:1206 src/ui-goodies.lisp:1224
#: src/ui-goodies.lisp:1188 src/ui-goodies.lisp:1221 src/ui-goodies.lisp:1239
msgid "Username: "
msgstr ""
#: src/ui-goodies.lisp:1183
#: src/ui-goodies.lisp:1198
#, lisp-format
msgid "Added crypto key for user ~s"
msgstr ""
#: src/ui-goodies.lisp:1186
#: src/ui-goodies.lisp:1201
msgid "Key: "
msgstr ""
#: src/ui-goodies.lisp:1200
#: src/ui-goodies.lisp:1215
#, lisp-format
msgid "Generated key for user ~s"
msgstr ""
#: src/ui-goodies.lisp:1201
#: src/ui-goodies.lisp:1216
#, lisp-format
msgid "user ~s key ~s"
msgstr ""
#: src/ui-goodies.lisp:1217
#: src/ui-goodies.lisp:1232
#, lisp-format
msgid "Added key for user ~s: ~a"
msgstr ""
#: src/ui-goodies.lisp:1234
#: src/ui-goodies.lisp:1249
msgid "About this software"
msgstr ""
#: src/ui-goodies.lisp:1246
#: src/ui-goodies.lisp:1261
msgid "Clearing pagination data"
msgstr ""
#: src/ui-goodies.lisp:1265
#: src/ui-goodies.lisp:1280
msgid "Invalid choices, usa a space separated list of positive integers."
msgstr ""
#: src/ui-goodies.lisp:1282
#: src/ui-goodies.lisp:1297
#, lisp-format
msgid "Invalid choices, index choice out of range (max ~a)."
msgstr ""
#: src/ui-goodies.lisp:1284
#: src/ui-goodies.lisp:1299
msgid "Voting... "
msgstr ""
#: src/ui-goodies.lisp:1285
#: src/ui-goodies.lisp:1300
msgid "Choice sent."
msgstr ""
#: src/ui-goodies.lisp:1294
#: src/ui-goodies.lisp:1309
msgid "Type the index (or space separated indices) of selected choices: "
msgstr ""
#: src/ui-goodies.lisp:1295
#: src/ui-goodies.lisp:1310
msgid "This in not a poll"
msgstr ""

3
quick_quicklisp.sh.in
View File

@ -119,6 +119,9 @@ install_dependency () {
--eval "(ql:quickload \"crypto-shortcuts\")" \
--eval "(ql:quickload \"drakma\")" \
--eval "(ql:quickload \"usocket\")" \
--eval "(ql:quickload \"cffi\")" \
--eval "(ql:quickload \"babel\")" \
--eval "(ql:quickload \"puri\")" \
--eval "(sb-ext:quit)";
}

42
src/db.lisp
View File

@ -113,6 +113,9 @@
(define-constant +table-conversation+ :conversation
:test #'eq)
(define-constant +table-gemini-tofu-cert+ :gemini-tofu-cert
:test #'eq)
(define-constant +federated-timeline+ "federated"
:test #'string=)
@ -474,6 +477,15 @@
" folder TEXT NOT NULL "
+make-close+)))
(defun make-tofu-certs ()
(query-low-level (strcat (prepare-table +table-gemini-tofu-cert+ :autoincrementp t)
" host TEXT NOT NULL, "
" hash TEXT NOT NULL, "
;; timestamp
" \"seen-at\" TEXT NOT NULL,"
" UNIQUE(hash) ON CONFLICT FAIL"
+make-close+)))
(defun build-all-indices ()
(create-table-index +table-status+ '(:folder :timeline :status-id))
(create-table-index +table-account+ '(:id :acct))
@ -483,7 +495,8 @@
(create-table-index +table-skipped-status+ '(:folder :timeline :status-id))
(create-table-index +table-pagination-status+ '(:folder :timeline :status-id))
(create-table-index +table-conversation+ '(:id))
(create-table-index +table-cache+ '(:id :key)))
(create-table-index +table-cache+ '(:id :key))
(create-table-index +table-gemini-tofu-cert+ '(:hash)))
(defmacro gen-delete (suffix &rest names)
`(progn
@ -505,7 +518,8 @@
+table-ignored-status+
+table-skipped-status+
+table-poll-option+
+table-poll+))
+table-poll+
+table-gemini-tofu-cert+))
(defun build-views ())
@ -534,6 +548,7 @@
(make-pagination-status)
(make-poll-option)
(make-poll)
(make-tofu-certs)
(build-all-indices)
(fs:set-file-permissions (db-path) (logior fs:+s-irusr+ fs:+s-iwusr+))))
@ -2523,3 +2538,26 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cage-days-offset)'"
(offset (threshold-time days-in-the-past)))
(local-time:timestamp< access-time
offset)))))
(defun tofu-passes-p (host hash)
(let ((known-hash (fetch-single (select :*
(from +table-gemini-tofu-cert+)
(where (:= :hash hash)))))
(known-host (fetch-single (select :*
(from +table-gemini-tofu-cert+)
(where (:= :host host))))))
(cond
(known-hash
(string= (db-getf known-hash :host)
host))
(known-host
nil)
(t
(with-db-current-timestamp (now)
(query (make-insert +table-gemini-tofu-cert+
(:host :hash :seen-at)
(host hash now)))
t)))))
(defun tofu-delete (host)
(query (delete-from +table-gemini-tofu-cert+ (where (:= :host host)))))

3
src/filesystem-utils.lisp
View File

@ -193,7 +193,8 @@
(setf res (concatenate 'string res *directory-sep* i)))
(setf res (concatenate 'string res *directory-sep*))
res))
((null splitted)
((or (= (length splitted) 1)
(null splitted))
*directory-sep*)
(t
path))))

89
src/gemini-viewer.lisp Normal file
View File

@ -0,0 +1,89 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :gemini-viewer)
(defun request (url)
(let ((parsed-uri (puri:parse-uri url)))
(if (null parsed-uri)
(ui:error-message (format nil
(_ "Could not understand the address ~s")
url))
(let ((host (puri:uri-host parsed-uri))
(path (puri:uri-path parsed-uri))
(query (puri:uri-query parsed-uri))
(port (or (puri:uri-port parsed-uri)
gemini-client:+gemini-default-port+)))
(handler-case
(progn
(multiple-value-bind (status x meta body gemini-text gemini-links)
(gemini-client:request host
path
:query query
:port port)
(declare (ignore x))
(cond
((gemini-client:response-redirect-p status)
(flet ((on-input-complete (maybe-accepted)
(when (ui::boolean-input-accepted-p maybe-accepted)
(let ((new-url (gemini-parser:absolutize-link meta
(puri:uri-host parsed-uri)
(puri:uri-port parsed-uri)
(puri:uri-path parsed-uri))))
(db-utils:with-ready-database (:connect nil)
(request new-url))))))
(ui:ask-string-input #'on-input-complete
:prompt
(format nil
(_ "Redirects to ~s, follows redirect? [y/N] ")
meta))))
((gemini-client:response-input-p status)
(flet ((on-input-complete (input)
(when (string-not-empty-p input)
(db-utils:with-ready-database (:connect nil)
(request (gemini-parser:make-gemini-uri host
path
input
port))))))
(ui:ask-string-input #'on-input-complete
:prompt
(format nil
(_ "Server ~s asks: ~s ")
host
meta))))
((gemini-client:response-sensitive-input-p status)
(error 'conditions:not-implemented-error
:text "Sensitive input not implemented"))
(gemini-text
(setf (message-window:source-text *message-window*)
gemini-text)
(setf (message-window:metadata *message-window*)
gemini-links)
(setf (keybindings *message-window*)
keybindings:*gemini-message-keymap*)
(draw *message-window*))
(t
(fs:with-anaphoric-temp-file (stream)
(write-sequence body stream)
(force-output stream)
(os-utils:xdg-open fs:temp-file))))))
(error (e)
(ui:error-message (format nil (_ "Error getting ~s: ~a") url e)))
(conditions:not-implemented-error (e)
(ui:error-message (format nil (_ "Error: ~a") e)))
(gemini-client:gemini-protocol-error (e)
(ui:error-message (format nil "~a" e))))))))

67
src/gemini/client.lisp
View File

@ -17,10 +17,6 @@
(in-package :gemini-client)
(define-constant +gemini-scheme+ "gemini" :test #'string=)
(define-constant +gemini-default-port+ 1965 :test #'=)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defclass response-status-code ()
((code
@ -137,6 +133,16 @@
(header-code= header +61+)
(header-code= header +62+)))
(defun response-input-p (code)
(code= code +10+))
(defun response-sensitive-input-p (code)
(code= code +11+))
(defun response-redirect-p (code)
(or (code= code +30+)
(code= code +31+)))
(define-condition gemini-protocol-error (error)
((error-code
:initarg :error-code
@ -146,12 +152,22 @@
:reader error-description))
(:report (lambda (condition stream)
(format stream
"The server responded with the error ~a: ~a"
(_ "The server responded with the error ~a: ~a")
(error-code condition)
(error-description condition))))
(:documentation "The condition signalled for error codes (i.e. 4x and 5x)"))
(defun parse-response (stream)
(define-condition gemini-tofu-error (error)
((host
:initarg :host
:reader host))
(:report (lambda (condition stream)
(format stream
(_ "The certificate of host ~a has changed from your latest visit.")
(host condition))))
(:documentation "The condition signalled when tofu failed"))
(defun parse-response (stream host port path)
(let* ((header (read-line stream))
(parsed-header (parse-gemini-response-header (format nil "~a~a" header #\Newline))))
(with-accessors ((meta meta)
@ -165,13 +181,18 @@
((header-success-p parsed-header)
(let ((body (read-all stream)))
(if (mime-gemini-p meta)
(let ((parsed (parse-gemini-file (babel:octets-to-string body))))
(let ((parsed (parse-gemini-file (babel:octets-to-string body
:errorp nil))))
(values status-code
(description +20+)
meta
parsed
(sexp->text parsed)
(sexp->links parsed)))
(format nil
"-> ~a://~a:~a~a~2%~a"
+gemini-scheme+
host port path
(sexp->text parsed))
(sexp->links parsed host port path)))
(results +20+ body))))
((or (header-input-request-p parsed-header)
(header-redirect-p parsed-header))
@ -188,14 +209,14 @@
(t
parsed-header))))))
(defun absolute-url-p (url)
(text-utils:string-starts-with-p +gemini-scheme+ url))
(defun request (host path &key
(query nil)
(port +gemini-default-port+))
(let ((uri (strcat +gemini-scheme+ "://"
host ":"
(to-s port) "/"
path))
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
(let* ((uri (make-gemini-uri host path query port))
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
(when query
(setf uri (strcat uri "?" query)))
(cl+ssl:with-global-context (ctx :auto-free-p t)
@ -205,13 +226,17 @@
:element-type '(unsigned-byte 8))
(let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream
:external-format
'(:utf-8)
'(:ASCII)
:unwrap-stream-p t
:verify nil
:hostname host))
(request (format nil "~a~a~a" uri #\Return #\Newline)))
(write-string request ssl-stream)
(force-output ssl-stream)
(multiple-value-bind (status description meta body gemini-text gemini-links)
(parse-response ssl-stream)
(values status description meta body gemini-text gemini-links)))))))
(request (format nil "~a~a~a" uri #\Return #\Newline))
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
(if (not (db:tofu-passes-p host cert-hash))
(error 'gemini-tofu-error :host host)
(progn
(write-string request ssl-stream)
(force-output ssl-stream)
(multiple-value-bind (status description meta body gemini-text gemini-links)
(parse-response ssl-stream host port path)
(values status description meta body gemini-text gemini-links)))))))))

22
src/gemini/gemini-constants.lisp Normal file
View File

@ -0,0 +1,22 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :gemini-constants)
(define-constant +gemini-scheme+ "gemini" :test #'string=)
(define-constant +gemini-default-port+ 1965 :test #'=)

121
src/gemini/gemini-parser.lisp
View File

@ -159,12 +159,118 @@
(defun tag-value (node)
(first (html-utils:children node)))
(defun sexp->links (parsed-gemini)
(defun path-last-dir (path)
(if (char= (last-elt path) #\/)
path
(fs:parent-dir-path path)))
(defun make-gemini-uri (host path &optional (query nil) (port +gemini-default-port+))
(let* ((actual-path (if (string-starts-with-p "/" path)
(subseq path 1)
path))
(actual-port (if port
(to-s port)
(to-s +gemini-default-port+)))
(uri (strcat +gemini-scheme+ "://"
host ":"
actual-port "/"
actual-path)))
(when query
(setf uri (strcat uri "?" query)))
uri))
(defgeneric normalize-path (object))
(defmethod normalize-path ((object null))
nil)
(defmethod normalize-path ((object string))
(flet ((make-stack ()
(make-instance 'stack:stack
:test-fn #'string=))
(fill-input-stack (stack)
(loop
for segment in (remove-if #'string-empty-p
(reverse (split "/" object)))
do
(stack:stack-push stack segment))))
(let* ((ends-with-separator-p (string-ends-with-p "/" object))
(ends-with-dots nil)
(input-stack (make-stack))
(output-stack (make-stack)))
(fill-input-stack input-stack)
(labels ((fill-output-buffer ()
(when (not (stack:stack-empty-p input-stack))
(let ((popped (stack:stack-pop input-stack)))
(cond
((and (string= popped "..")
(not (stack:stack-empty-p output-stack))
(not (stack:stack-empty-p input-stack)))
(stack:stack-pop output-stack))
((and (or (string= popped "..")
(string= popped "."))
(stack:stack-empty-p input-stack))
(setf ends-with-dots t))
((and (string/= popped ".")
(string/= popped ".."))
(stack:stack-push output-stack popped))))
(fill-output-buffer)))
(output-stack->list ()
(reverse (loop
for segment = (stack:stack-pop output-stack)
while segment
collect segment))))
(fill-output-buffer)
(let* ((joinable (output-stack->list))
(merged (if joinable
(if (or ends-with-separator-p
ends-with-dots)
(wrap-with (join-with-strings joinable "/") "/")
(strcat "/" (join-with-strings joinable "/")))
"/")))
(regex-replace-all "//" merged ""))))))
(defmethod normalize-path ((object puri:uri))
(let ((clean-path (normalize-path (puri:uri-path object)))
(copy (puri:copy-uri object)))
(when clean-path
(setf (puri:uri-path copy) clean-path))
copy))
(defmethod to-s ((object puri:uri))
(with-output-to-string (stream)
(puri:render-uri object stream)))
(defun absolutize-link (link-value original-host original-port original-path)
(let ((parsed (puri:parse-uri link-value)))
(cond
((null parsed)
(error "Unparsable address"))
((null (puri:uri-host parsed))
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
(path (if absolute-path-p
link-value
(strcat (path-last-dir original-path)
link-value))))
(make-gemini-uri original-host
(normalize-path path)
nil
original-port)))
((null (puri:uri-scheme parsed))
(strcat +gemini-scheme+ ":"
(to-s (normalize-path parsed))))
(t
(to-s (normalize-path parsed))))))
(defun sexp->links (parsed-gemini original-host original-port original-path)
(loop for node in parsed-gemini when (html-utils:tag= :a node) collect
(make-instance 'gemini-link
:target (html-utils:attribute-value (html-utils:find-attribute :href
node))
:name (tag-value node))))
(let ((link-value (html-utils:attribute-value (html-utils:find-attribute :href node))))
(make-instance 'gemini-link
:target (absolutize-link link-value
original-host
original-port
original-path)
:name (tag-value node)))))
(defun sexp->text (parsed-gemini)
(labels ((underlineize (stream text underline-char)
@ -183,6 +289,8 @@
(cond
((null node)
(format stream "~%"))
((html-utils:tag= :text node)
(format stream "~a~%" (text-value node)))
((html-utils:tag= :h1 node)
(underlineize stream
(text-value node)
@ -217,7 +325,8 @@
(format stream "[~a]~%" link-value)))))))))
(defun parse-gemini-file (data)
(parse 'gemini-file data :junk-allowed t))
(parse 'gemini-file (strcat data (string #\Newline))
:junk-allowed t))
;; response header

20
src/gemini/package.lisp
View File

@ -14,6 +14,14 @@
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(defpackage :gemini-constants
(:use
:cl
:alexandria)
(:export
:+gemini-scheme+
:+gemini-default-port+))
(defpackage :gemini-parser
(:use
:cl
@ -24,9 +32,11 @@
:constants
:text-utils
:misc
:alexandria)
:alexandria
:gemini-constants)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+gemini-scheme+
:gemini-link
:target
:name
@ -34,6 +44,8 @@
:status-code
:meta
:parse-gemini-file
:absolutize-link
:make-gemini-uri
:sexp->links
:sexp->text
:parse-gemini-response-header))
@ -49,10 +61,16 @@
:text-utils
:misc
:alexandria
:gemini-constants
:gemini-parser)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+gemini-default-port+
:gemini-protocol-error
:error-code
:error-description
:response-input-p
:response-sensitive-input-p
:response-redirect-p
:absolute-url-p
:request))

7
src/keybindings.lisp
View File

@ -228,6 +228,9 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *message-keymap* (make-starting-comand-tree)
"The keymap for message window.")
(defparameter *gemini-message-keymap* (make-starting-comand-tree)
"The keymap for message-window when displaing gemini text.")
(defparameter *tags-keymap* (make-starting-comand-tree)
"The keymap for tags window.")
@ -246,6 +249,10 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *open-message-link-keymap* (make-starting-comand-tree)
"The keymap for window to open message's links.")
(defparameter *open-gemini-link-keymap* (make-starting-comand-tree)
"The keymap for window to open gemini's links.")
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
"Define a key sequence that trigger a function:

20
src/line-oriented-window.lisp
View File

@ -101,7 +101,17 @@
:initform 0
:initarg :y-current-row
:accessor y-current-row
:documentation "The active line position"))
:documentation "The active line position")
(top-rows-slice
:initform 0
:initarg :top-rows-slice
:accessor top-rows-slice
:documentation "The start index of the visible rows")
(bottom-rows-slice
:initform 0
:initarg :bottom-rows-slice
:accessor bottom-rows-slice
:documentation "The start index of the visible rows"))
(:documentation "A widget that holds a selectable list of lines"))
(defmethod initialize-instance :after ((object row-oriented-widget) &key &allow-other-keys)
@ -138,15 +148,21 @@
(with-accessors ((top-row-padding top-row-padding)
(current-row-index current-row-index)
(row-selected-index row-selected-index)
(single-row-height single-row-height)
(top-rows-slice top-rows-slice)
(bottom-rows-slice bottom-rows-slice)
(rows rows)) object
(let* ((window-height (if (uses-border-p object)
(win-height-no-border object)
(win-height object)))
(available-rows (- window-height top-row-padding))
(available-rows (truncate (/ (- window-height top-row-padding)
single-row-height)))
(selected-top-offset (rem row-selected-index available-rows))
(top (- row-selected-index selected-top-offset))
(bottom (+ row-selected-index
(- available-rows selected-top-offset))))
(setf top-rows-slice top
bottom-rows-slice bottom)
(values (safe-subseq rows top bottom)
selected-top-offset))))

10
src/message-window.lisp
View File

@ -27,7 +27,15 @@
(line-position-mark
:initform (make-tui-string "0")
:initarg :line-position-mark
:accessor line-position-mark)))
:accessor line-position-mark)
(metadata
:initform nil
:initarg :metadata
:accessor metadata)))
(defun display-gemini-text-p (window)
(eq (keybindings window)
keybindings:*gemini-message-keymap*))
(defgeneric prepare-for-rendering (object))

84
src/open-message-link-window.lisp
View File

@ -68,4 +68,86 @@
*open-message-link-window*))
(defun open-message-link (url)
(os-utils:xdg-open url))
(if (string-starts-with-p gemini-constants:+gemini-scheme+ url)
(gemini-viewer:request url)
(os-utils:xdg-open url)))
(defclass open-gemini-document-link-window (focus-marked-window
simple-line-navigation-window
title-window
border-window)
((links
:initform ()
:initarg :links
:accessor links)))
(defmethod refresh-config :after ((object open-gemini-document-link-window))
(open-attach-window:refresh-view-links-window-config object
swconf:+key-open-message-link-window+))
(defmethod resync-rows-db ((object open-gemini-document-link-window)
&key
(redraw t)
(suggested-message-index nil))
(with-accessors ((rows rows)
(links links)
(selected-line-bg selected-line-bg)
(selected-line-fg selected-line-fg)) object
(flet ((make-rows (links bg fg)
(mapcar (lambda (link)
(make-instance 'line
:normal-text (gemini-parser:target link)
:selected-text (gemini-parser:target link)
:normal-bg bg
:normal-fg fg
:selected-bg fg
:selected-fg bg))
links)))
(with-croatoan-window (croatoan-window object)
(setf rows (make-rows links
selected-line-bg
selected-line-fg))
(when suggested-message-index
(select-row object suggested-message-index))
(when redraw
(draw object))))))
(defmethod draw :before ((object open-gemini-document-link-window))
(with-accessors ((links links)
(single-row-height single-row-height)
(top-row-padding top-row-padding)
(new-messages-mark new-messages-mark)
(top-rows-slice top-rows-slice)
(bottom-rows-slice bottom-rows-slice)) object
(renderizable-rows-data object) ; set top and bottom slice
(win-clear object)
(with-croatoan-window (croatoan-window object)
(loop
for link in (safe-subseq links top-rows-slice bottom-rows-slice)
for y from (+ 2 top-row-padding) by single-row-height do
(print-text object
(gemini-parser:name link)
1 y
:bgcolor (bgcolor croatoan-window)
:fgcolor (fgcolor croatoan-window))))))
(defun init-gemini-links (links)
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *open-message-link-window*
(make-instance 'open-gemini-document-link-window
:title (_ "Links")
:links links
:single-row-height 2
:uses-border-p t
:keybindings keybindings:*open-message-link-keymap*
:croatoan-window low-level-window))
(refresh-config *open-message-link-window*)
(resync-rows-db *open-message-link-window* :redraw nil)
(when (rows *open-message-link-window*)
(select-row *open-message-link-window* 0))
(draw *open-message-link-window*)
*open-message-link-window*))
(defun forget-gemini-link-window ()
(setf (keybindings *message-window*)
keybindings:*message-keymap*))

42
src/package.lisp
View File

@ -347,6 +347,7 @@
:string-empty-p
:string-not-empty-p
:string-starts-with-p
:string-ends-with-p
:trim-blanks
:find-max-line-length
:box-fit-single-column
@ -594,6 +595,13 @@
:stack-empty-p
:do-stack-element))
(defpackage :x509
(:use
:cl
:alexandria)
(:export
:dump-certificate))
(defpackage :db-utils
(:use
:cl
@ -842,7 +850,9 @@
:cache-put
:cache-get
:cache-get-value
:cache-expired-p))
:cache-expired-p
:tofu-passes-p
:tofu-delete))
(defpackage :date-formatter
(:use
@ -1291,10 +1301,12 @@
:*tags-keymap*
:*conversations-keymap*
:*message-keymap*
:*gemini-message-keymap*
:*send-message-keymap*
:*follow-requests-keymap*
:*open-attach-keymap*
:*open-message-link-keymap*
:*open-gemini-link-keymap*
:define-key
:init-keyboard-mapping
:find-keymap-node
@ -1558,6 +1570,8 @@
:rows
:row-selected-index
:y-current-row
:top-rows-slice
:bottom-rows-slice
:renderizable-rows-data
:unselect-all
:select-row
@ -1661,6 +1675,8 @@
(:export
:message-window
:source-text
:metadata
:display-gemini-text-p
:scroll-down
:scroll-up
:scroll-end
@ -1713,9 +1729,10 @@
:tui-utils)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:open-message-link-window
:open-message-link
:init))
:init
:init-gemini-links
:forget-gemini-link-window))
(defpackage :command-window
(:use
@ -1845,6 +1862,25 @@
:resync-rows-db
:init))
(defpackage :gemini-viewer
(:use
:cl
:alexandria
:cl-ppcre
:access
:croatoan
:config
:constants
:text-utils
:misc
:specials
:windows
:line-oriented-window
:tui-utils)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:request))
(defpackage :main-window
(:use
:cl

6
src/stack.lisp
View File

@ -32,7 +32,7 @@
(defmethod print-object ((object stack) stream)
(print-unreadable-object (object stream :type t :identity nil)
(format stream "~a" (container object))))
(format stream "~s" (container object))))
(defgeneric stack-push (object val))
@ -57,8 +57,8 @@
(with-accessors ((container container)) object
(if (not (stack-empty-p object))
(prog1
(alexandria:last-elt container)
(setf container (misc:safe-delete@ container (1- (length container)))))
(alexandria:first-elt container)
(setf container (misc:safe-delete@ container 0)))
nil)))
(defmethod stack-find ((object stack) val)

30
src/tests/gemini-parser-tests.lisp Normal file
View File

@ -0,0 +1,30 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :gemini-parser-tests)
(defsuite gemini-parser-suite (all-suite))
(defun normalize (path expected)
(string= (gemini-parser::normalize-path path)
expected))
(deftest test-normalize-path (gemini-parser-suite)
(assert-true (normalize "/a/x" "/a/x"))
(assert-true (normalize "/a/../b/x" "/b/x"))
(assert-true (normalize "/a/../b/x/.." "/b/x/"))
(assert-true (normalize "/a/../b/x/." "/b/x/")))

9
src/tests/package.lisp
View File

@ -77,3 +77,12 @@
:all-tests
:thread-window)
(:export))
(defpackage :gemini-parser-tests
(:use :cl
:clunit
:misc
:text-utils
:all-tests
:gemini-parser)
(:export))

11
src/text-utils.lisp
View File

@ -224,12 +224,19 @@
(not (string-empty-p s)))
(defun string-starts-with-p (start s &key (test #'string=))
"Return non nil if `s' starts with the substring `start'.
Uses `test' to match strings (default #'string="
"Returns non nil if `s' starts with the substring `start'.
Uses `test' to match strings (default #'string=)"
(when (>= (length s)
(length start))
(funcall test s start :start1 0 :end1 (length start))))
(defun string-ends-with-p (end s &key (test #'string=))
"Returns t if s ends with the substring 'end', nil otherwise.
Uses `test' to match strings (default #'string=)"
(when (>= (length s)
(length end))
(funcall test s end :start1 (- (length s) (length end)))))
(defvar *blanks* '(#\Space #\Newline #\Backspace #\Tab
#\Linefeed #\Page #\Return #\Rubout))

19
src/ui-goodies.lisp
View File

@ -905,14 +905,21 @@ Force the checking for new message in the thread the selected message belong."
(defun close-open-attach-window ()
(close-window-and-return-to-threads specials:*open-attach-window*))
(defun open-gemini-message-link-window ()
(let ((links (message-window:metadata specials:*message-window*)))
(open-message-link-window:init-gemini-links links)
(focus-to-open-message-link-window)))
(defun open-message-link ()
"Open message links window
Browse and optionally open the links the messages contains."
(when-let* ((win specials:*thread-window*)
(selected-message (line-oriented-window:selected-row-fields win)))
(open-message-link-window:init (db:row-message-status-id selected-message))
(focus-to-open-message-link-window)))
Browse and optionally open the links the text of the message window contains."
(if (message-window:display-gemini-text-p specials:*message-window*)
(open-gemini-message-link-window)
(when-let* ((win specials:*thread-window*)
(selected-message (line-oriented-window:selected-row-fields win)))
(open-message-link-window:init (db:row-message-status-id selected-message))
(focus-to-open-message-link-window))))
(defun open-message-link-move (amount)
(ignore-errors
@ -932,6 +939,8 @@ Browse and optionally open the links the messages contains."
(open-message-link-window:open-message-link url)))
(defun close-open-message-link-window ()
(when (message-window:display-gemini-text-p specials:*open-message-link-window*)
(open-message-link-window:forget-gemini-link-window))
(close-window-and-return-to-threads specials:*open-message-link-window*))
(defun prompt-for-username (prompt complete-function event

22
src/x509-ffi.lisp Normal file
View File

@ -0,0 +1,22 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :x509)
;;int i2d_X509(X509 *x, unsigned char **out)
(cffi:defcfun (i2d-x509 "i2d_X509") :int (cert :pointer) (buff :pointer))

32
src/x509.lisp Normal file
View File

@ -0,0 +1,32 @@
;; tinmop: an humble mastodon client
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :x509)
(defun dump-certificate (ssl-stream)
(let ((cert (cl+ssl:ssl-stream-x509-certificate ssl-stream)))
(cffi:with-foreign-object (buf* :pointer)
(cffi:with-foreign-object (buf** :pointer)
(setf (cffi:mem-ref buf** :pointer) buf*)
(let ((len (i2d-x509 cert buf**)))
(if (< len 0)
(error "i2d-X509 failed")
(let* ((data (loop for i from 0 below len collect
(cffi:mem-aref buf* :unsigned-char i)))
(res (misc:make-fresh-array len 0 '(unsigned-byte 8) t)))
(misc:copy-list-into-array data res)
res)))))))

15
tinmop.asd
View File

@ -48,6 +48,8 @@
:crypto-shortcuts
:drakma
:usocket
:babel
:puri
:uiop)
:components ((:file "package")
(:file "config")
@ -69,12 +71,15 @@
(:file "priority-queue")
(:file "queue")
(:file "stack")
(:module gemini
:components ((:file "package")
(:file "gemini-parser")
(:file "client")))
(:file "x509-ffi")
(:file "x509")
(:file "db-utils")
(:file "db")
(:module gemini
:components ((:file "package")
(:file "gemini-constants")
(:file "gemini-parser")
(:file "client")))
(:file "date-formatter")
(:file "emoji-shortcodes")
(:file "software-configuration")
@ -105,6 +110,7 @@
(:file "follow-requests")
(:file "tags-window")
(:file "conversations-window")
(:file "gemini-viewer")
(:file "main-window")
(:file "ui-goodies")
(:file "modules")
@ -118,6 +124,7 @@
(:file "text-utils-tests")
(:file "mtree-tests")
(:file "thread-window-tests")
(:file "gemini-parser-tests")
(:file "program-events-tests")))))
;; (push :debug-mode *features*)