From b803427b65b26ec297322de115e8dcbae55b033e Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Thu, 13 Apr 2023 19:07:17 +1000 Subject: [PATCH] initial capture --- Makefile | 7 ++ lsp-dbus-test.lsp | 39 +++++++ lsp-dbus/Makefile | 9 ++ lsp-dbus/lsp-dbus-connection.lsp | 82 ++++++++++++++ lsp-dbus/lsp-dbus-events.lsp | 33 ++++++ lsp-dbus/lsp-dbus-marshal.lsp | 185 +++++++++++++++++++++++++++++++ lsp-dbus/lsp-dbus.lsp | 124 +++++++++++++++++++++ lsp-util/Makefile | 6 + lsp-util/foop.lsp | 61 ++++++++++ lsp-util/misc.lsp | 16 +++ 10 files changed, 562 insertions(+) create mode 100644 Makefile create mode 100644 lsp-dbus-test.lsp create mode 100644 lsp-dbus/Makefile create mode 100644 lsp-dbus/lsp-dbus-connection.lsp create mode 100644 lsp-dbus/lsp-dbus-events.lsp create mode 100644 lsp-dbus/lsp-dbus-marshal.lsp create mode 100644 lsp-dbus/lsp-dbus.lsp create mode 100644 lsp-util/Makefile create mode 100644 lsp-util/foop.lsp create mode 100644 lsp-util/misc.lsp diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..93cfb40 --- /dev/null +++ b/Makefile @@ -0,0 +1,7 @@ + +LSPLIB = -A lsp-util/lsp-util.a -A lsp-dbus/lsp-dbus.a + +LSPSRC = lsp-dbus-test.lsp + +test0: ${LSPSRC} + ${HOME}/src/borta/packnl/packnl -w $@ $^ ${LSPLIB} diff --git a/lsp-dbus-test.lsp b/lsp-dbus-test.lsp new file mode 100644 index 0000000..0c13db4 --- /dev/null +++ b/lsp-dbus-test.lsp @@ -0,0 +1,39 @@ +#!/usr/bin/newlisp + +;; This is a test program for the lsp-dbus provided dbus API. + +(load "misc.lsp") +(load "lsp-dbus.lsp") + +; Log system bus details +(println Dbus:SYSTEM-BUS) +(println (setf ME (Dbus "/au/rrq"))) +(println (setf ROOT (Dbus "/org/freedesktop/DBus"))) + +(define (unpack-messages DATA) + (let ((AT 0) (OUT '()) (M nil) (D nil)) + (while (and (< AT (length DATA)) + (setf M (Dbus:unpack-data "yyyyuua(yv)" DATA AT))) + ;;(println M) + (dotimes (i (length (M 0 -1))) + (setf (M 0 -1 i 0) (Dbus:MESSAGE-HEADERS (M 0 -1 i 0) 0))) + (println M) + (setf AT (M 1)) + (setf S ((lookup 'Dbus:SIGNATURE (M 0 -1)) 0)) + (println "AT=" AT " " (unpack (dup "b" 20) (AT DATA))) + (if (and (< AT (length DATA)) (!= s "")) + (when (setf D (Dbus:unpack-data S DATA AT)) + (println D) + (setf AT (D 1)) + (push (list M (D 0)) OUT -1)) + (push (list M nil) OUT -1)) + (setf DATA (AT DATA)) + (setf AT 0) + ;;(println (octals-string (AT DATA))) + ) + OUT )) + +(setf M (:invoke ROOT "Hello" "org.freedesktop.DBus")) +(println (unpack-messages M)) + +"lsp-dbus-test.lsp" diff --git a/lsp-dbus/Makefile b/lsp-dbus/Makefile new file mode 100644 index 0000000..bd97a2f --- /dev/null +++ b/lsp-dbus/Makefile @@ -0,0 +1,9 @@ +# Create the newlisp library dbus.lsplib + +LSPSRC = lsp-dbus-connection.lsp lsp-dbus.lsp lsp-dbus-marshal.lsp +LSPSRC += lsp-dbus-events.lsp + +lsp-dbus.a: ${LSPSRC} + ar r $@ $^ + + diff --git a/lsp-dbus/lsp-dbus-connection.lsp b/lsp-dbus/lsp-dbus-connection.lsp new file mode 100644 index 0000000..3ac9b06 --- /dev/null +++ b/lsp-dbus/lsp-dbus-connection.lsp @@ -0,0 +1,82 @@ +;; This newlisp module implements dbus socket connection +;; + +; Require the FOOP context +(unless (context? MAIN:FOOP) (load "foop.lsp")) + +(context 'MAIN:DbusConnection) +(FOOP path socket name serial) + +(define (DbusConnection:DbusConnection PATH) + (list (context) PATH -1 nil 0)) + +;; Increment the serial and return it. +(define (serial++) + (!serial (+ 1 (%serial)))) + +;; (open-socket) +; Internal utility method to re-open the %path socket and set the +; %socket field. +(define (open-socket) + (when (>= (%socket)) + (close (%socket)) + (!socket -1)) + (!socket (net-connect (%path)))) + +;** Commands from client to server +; AUTH [mechanism] [initial-response] +; CANCEL +; BEGIN +; DATA +; ERROR [human-readable error explanation] +; NEGOTIATE_UNIX_FD + +;** Commands from server to client +; REJECTED +; OK +; DATA +; ERROR [human-readable error explanation] +; AGREE_UNIX_FD + +(define (read-message) + (let ((BUFFER "") (RESULT "")) + (while (net-select (%socket) "r" 1000) + (net-receive (%socket) BUFFER 8192) + (extend RESULT BUFFER)) + RESULT)) + +;; (handshake MSG PAT) +; Perform a socket handshake sending MSG and return the result, or if +; PAT not nil, then return (regex PAT RESULT 0), +(define (handshake MSG PAT) + (let ((RESULT "")) + (net-send (%socket) MSG) + (setf RESULT (read-message)) + (if PAT (regex PAT RESULT 0) RESULT))) + +(define (char2hex STR) + (join (map (curry format "%2x") (map char (explode STR))))) + +(constant + 'AUTHFMT "AUTH EXTERNAL %s\r\n" + 'AUTHACK "OK (\\S+)\r\n" + 'KEEPFMT "NEGOTIATE_UNIX_FD\r\n" + 'KEEPACK "AGREE_UNIX_FD\r\n" + ) + +;; (initialize USER) +; Perform socket initialization sequence and return the name, or nil. +(define (initialize (USER (env "USER"))) + (when (and (>= (open-socket)) + (net-send (%socket) (char 0)) + (handshake (format AUTHFMT (char2hex USER)) AUTHACK) + (!name $1) + (handshake KEEPFMT KEEPACK)) + (handshake "BEGIN\r\n") + (%name))) + +(define (cancel) + (handshake "CANCEL\r\n" "(.*)")) + +"DbusConnection" + diff --git a/lsp-dbus/lsp-dbus-events.lsp b/lsp-dbus/lsp-dbus-events.lsp new file mode 100644 index 0000000..6e93994 --- /dev/null +++ b/lsp-dbus/lsp-dbus-events.lsp @@ -0,0 +1,33 @@ +;; This newlisp module implements dbus socket send-receive together +;; with signal receive. +; +; This should be included into the Dbus contect + +(setf pending '()) + +(define 'RECV:RECV nil) ; Table of objects that receive calls/signals + +(define (set-object PATH HANDLER) (RECV PATH HANDLER)) + +(define (process-signal DATA) + (let ((MSG (unpack-message "uuuuyya(yv)" DATA))) + ;; Determine object concerned + ;; Determine that object's handler for this signal + ;; Call the handler with signal data + )) + +(define (send-recv--message MSG) + ;; Pack the message into a data block + (:send-message SYSTEM-SOCKET) + (while (unrelated (setf MSEG (:read-message SYSTEM-BUS ))) + (push MSG pending -1)) + MSG) + +;; The main-loop is intended as a prompt-handler so as to deal with +;; asyncronous events +(define (main-loop) + (let ((FDS (list 0 (:%socket SYSTEM-BUS)))) + (while (and (empty? pending) (not (member 0 (net-select FDS "r" -1)))) + (if (pop pending) (process-signal $it) + (if (:read-message SYSTEM-BUS) (push $it pending -1))) + ))) \ No newline at end of file diff --git a/lsp-dbus/lsp-dbus-marshal.lsp b/lsp-dbus/lsp-dbus-marshal.lsp new file mode 100644 index 0000000..4e72ef6 --- /dev/null +++ b/lsp-dbus/lsp-dbus-marshal.lsp @@ -0,0 +1,185 @@ +;; This newlisp "module" implements dbus marshalling +; +; The newlisp representation is a simplified form using lists for +; structs and arrays + +;;================ +; Expland a signature string into a nested list to correspond to the +; newlisp list representation. Basic dbus types are basic newlisp +; types, including strings. Arrays and structs are sublists. The +; signature marks array sublists with an initial "a", otherwise it's a +; struct sublist. +; +; Ex: "yi" = ("y" "i") +; Ex: "y(ai)" = ("y" (("a" "i"))) +; Ex: "a(yi)" = (("a" ("y" "i"))) +; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v"))) +(define (expand-signature S) + (println (list 'expand-signature S)) + (let ((STACK '()) (CUR '()) (A 0)) + (dolist (X (explode S)) + ;;(println "CUR=" CUR " X=" X) + (case X + (")" (setf X CUR) (setf CUR (pop STACK))) + ("(" (push CUR STACK) (setf CUR '())) + (true true)) + (when (and (!= X "a") (!= X "(")) + (while (and CUR (= "a" (last CUR))) + (setf X (list (last CUR) X)) + (setf CUR (chop CUR)))) + (when (!= "(" X) + (push X CUR -1))) + (if (null? CUR) '() (1 CUR) CUR (CUR 0)) )) + +;; Join arguments with a given byte-alignment +(define (pad-join N) + ;;(println (list 'pad-join AT N (args))) + (let ((OUT "")) + (dolist (S (args)) + (let ((PAD (dup "\000" (% (- N (% (length OUT) N)) N)))) + (extend OUT PAD S))) + OUT)) + +;; Pack data from DATA according to signature. The DATA is a nested +;; list where container types are sub lists. Variant types also appear +;; as pairs of signature and value. +(define (pack-data SIGN DATA) + (let ((AT 0)) (pack-data-struct (expand-signature SIGN) DATA))) + +;; Align AT to an I multiple by adding nul bytes, then extend it with +;; DATA, and increment AT +(define (pack-align DATA (I (length DATA))) + (let ((PAD (dup "\000" (% (- I (% AT I)) I)))) + ;;(println (list 'align AT I (length PAD))) + (setf DATA (extend PAD DATA)) + (inc AT (length DATA)) + DATA)) + +;; Advance AT to align by I +(define (align-unpack I FMT N) + ((list (inc AT (% (- I (% AT I)) I)) ; align to I + (unpack FMT (AT DATA)) + (inc AT N)) + 1 0)) ; return second term's first item + + +;; Pack a newlisp data element according to marshalling type The +;; newlisp data is integer, double, string or list (for container and +;; variant elements). +(constant + 'FMTMAP ; mapping dbus type code to byte size and newlisp code + '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer) + ("b" 1 "b") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid) + ("n" 2 "d") ; INT16 (signed 16-bit integer) + ("q" 2 "u") ; UINT16 (unsigned 16-bit integer) + ("i" 4 "ld") ; INT32 (signed 32-bit integer) + ("u" 4 "lu") ; UINT32 (unsigned 32-bit integer) + ("x" 8 "Ld") ; INT64 (signed 64-bit integer) + ("t" 8 "Lu") ; UINT64 (unsigned 64-bit integer) + ("d" 8 "lf") ; DOUBLE (64-bit float) + ("h" 4 "lu") ; UINT32 (unix file descriptor) + ("a" ? ?) ; ARRAY = UINT32 byte-length, items + ("s" ? ?) ; STRING = length + data + NUL + ("o" ? ?) ; OBJECT_PATH = BYTE length + data + NUL + ("g" ? ?) ; SIGNATURE = BYTE length + data + NUL + ("(" ? ?) ; STRUCT begin in signature = (8-align) + data + (")" 0 ?) ; STRUCT end in signature + ("v" ? ?) ; VARIANT = signature + data + ("{" ? ?) ; DICT_ENTRY begin + ("}" ? ?) ; DICT_ENTRY end + ("r" ? ?) ; reserved STRUCT in bindings? + ("e" ? ?) ; reserved DICT_ENTRY in bindings ? + ("m" ? ?) ; reserved 'maybe' + ("*" ? ?) ; reserved 'single complete type' + ("?" ? ?) ; reserved 'basic type' + ("@" ? ?) ; reserved + ("&" ? ?) ; reserved + ("^" ? ?) ; reserved + ) + ) + +(define (pack-data-item ES DATA) + ;;(println (list 'pack-data-item AT ES DATA)) + (if (list? ES) (pack-data-struct ES DATA) + (find ES "osg") (pack-data-string ES DATA) + (= ES "v") (apply pack-data-variant DATA) + (if (lookup ES FMTMAP) (pack-align (pack $it DATA))))) + +(define (pack-data-variant ES DATA) + ;;(println (list 'pack-data-variant AT ES DATA)) + (extend (pack-align (pack "bbb" 1 (char ES) 0) 1) + (pack-data-item ES DATA))) + +(define (pack-data-string ES DATA) + (pack-align (pack (format "lus%db" (length DATA)) (length DATA) DATA 0) 1)) + +;; Pack an array. DATA elements marshalled by repeating ES, preceded +;; by the array length in bytes as aligned UINT32. +(define (pack-data-array ES DATA) + ;;(println (list 'pack-data-array AT ES DATA)) + (let ((PAD (pack-align "" 4)) + (X (inc AT 4)) ; start index of array bytes + (DATA (apply extend (map (curry pack-data-item ES) DATA)))) + (extend PAD (pack "lu" (- AT X)) DATA))) + +;; Pack a struct. ES and DATA elements marshalled pairwise in order +;; following an initial8-byte alignment. +(define (pack-data-struct ES DATA) + ;;(println (list 'pack-data-struct AT ES DATA)) + (if (= "a" (ES 0)) + (pack-data-array (ES 1) DATA) + (apply extend (cons (pack-align "" 8) + (map pack-data-item ES DATA))))) + +;;########## unpacking + +(define (align-AT I) + (inc AT (% (- I (% AT I)) I))) + +(define (unpack-align I FMT) + (align-AT I) + (prog1 ((unpack FMT (AT DATA)) 0) (inc AT I))) + +(define (unpack-data-string ES) + ;;(println (list 'unpack-data-string ES AT (unpack "bbbb" (AT DATA)))) + (let ((N (if (= "g" ES) (unpack-align 1 "b") (unpack-align 4 "lu")))) + (prog1 (unpack (string "s" N) (AT DATA)) (inc AT (+ 1 N))))) + +(define (unpack-data-variant) + ;;(println (unpack "bbbb" (AT DATA))) + (let ((ES (char ((unpack "bbb" (AT DATA)) 1)))) + (inc AT 3) + (unpack-data-item ES))) + +;; Unpack the ES item from (AT DATA) and increment AT +(define (unpack-data-item ES) + ;;(println (list 'unpack-data-item ES AT (unpack "b" (AT DATA)))) + ;;(when (= ES "\000") (println (history true))) + (if (list? ES) (unpack-data-struct ES) + (find ES "+gosg") (unpack-data-string ES) + (= ES "v") (unpack-data-variant) + (if (assoc ES FMTMAP) (unpack-align ($it -2) ($it -1))))) + +;; Unpack array with ES elements. The array begins with an UINT32 +;; field telling how many bytes to unpack +(define (unpack-data-array ES) + ;;(println (list 'unpack-data-array ES)) + (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '())) + (while (< AT N) + ;;(println (list 'item AT N)) + (push (unpack-data-item ES) OUT -1)) + OUT)) + +;; Unpack a structure or array with ES fields. +(define (unpack-data-struct ES) + (if (= "a" (ES 0)) (unpack-data-array (ES 1)) + (begin (align-AT 8) (map unpack-data-item ES)))) + +;; Unpack from a DATA string according to signature SIGN This returns +;; a pair (unpacked pos) of unpacked data and how much data is +;; consumed. +(define (unpack-data SIGN DATA (AT 0)) + ;;(println (list 'unpack-data SIGN "DATA length " (length DATA))) + ;;(map println (explode (unpack (dup "b" (length (AT DATA))) (AT DATA)) 20)) + (list (unpack-data-item (expand-signature SIGN)) AT)) + diff --git a/lsp-dbus/lsp-dbus.lsp b/lsp-dbus/lsp-dbus.lsp new file mode 100644 index 0000000..e40c2eb --- /dev/null +++ b/lsp-dbus/lsp-dbus.lsp @@ -0,0 +1,124 @@ +;; This newlisp "module" sets up a dbus API adapter +;; +;; dbus is an object oriented interprocess commmunications framework +;; based on utual object proxying. This end holds some objects that +;; remote ends can access and invoke methods on, and remote ends hold +;; objects that this pocess can access and invoke methods on. +;; +;; https://dbus.freedesktop.org/doc/dbus-specification.html +;; https://dbus.freedesktop.org/doc/dbus-api-design.html +;; [C API] https://dbus.freedesktop.org/doc/api/html/ +;; + +(unless (context? MAIN:FOOP) (load "foop.lsp")) +(unless (context? MAIN:DbusConnection) (load "lsp-dbus-connection.lsp")) + +################################################################# +(context 'MAIN:Dbus) + +; Include marshalling functions +(load "lsp-dbus-marshal.lsp" MAIN:Dbus) + +;; Declaring the FOOP object +(FOOP path bus) + + +(setf SYSTEM-BUS (MAIN:DbusConnection "/run/dbus/system_bus_socket")) +(:initialize SYSTEM-BUS) + +;; "Constructor". Creates an adapter object for a given base path. +(define (Dbus:Dbus PATH (BUS 'SYSTEM-BUS)) + (list (context) PATH BUS)) + +;; Return the bus name +(define (bus-name) + (join (find-all "([^/]+)" (%path) $1 0) ".")) + +;; Return the DbusConnection connection adapter +(define (connection) + (eval (%bus))) + +;; ==================== +;; Dbus messages + +(constant + 'PROTOCOL-VERSION '(1 1) + 'MESSAGE-TYPES '(INVALID METHOD_CALL METHOD_RETURN ERROR SIGNAL) + 'MESSAGE-FLAGS '(NO_REPLY_EXPECTED + NO_AUTO_START + ALLOW_INTERACTIVE_AUTHORIZATION) + ;; Message headers: [code] (name type) + 'MESSAGE-HEADERS '((INVALID ) + (PATH "o") + (INTERFACE "s") + (MEMBER "s") + (ERROR_NAME "s") + (REPLY_SERIAL "i") + (DESTINATION "s") + (SENDER "s") + (SIGNATURE "g") + (UNIX_FDS "i") + ) + ) + +;; Determine the type code = index of teh type symbol in the +;; MESSAGE-TYPES list. +(define (message-type-code TYPE) + (or (find TYPE MESSAGE-TYPES =) 0)) + +(define (flag F) + (if (find F MESSAGE-FLAGS) (pow 2 $it) 0)) + +;; Combining header flag symbols into the flags code = bit-or of the +;; 2^x values where x is the index for the flag symbol in the +;; MESSAGE-FLAGS list. +(define (message-flags FLAGS) + (if (number? FLAGS) FLAGS + (list? FLAGS) (apply | (map flag FLAGS)) + 0)) + +;; (message-header (NAME VALUE)) +; Translate header into its marshalling data. The name is mapped to +; its header code and associated value type. This gets translated into +; the marshalling data form of (code (type value)) +(define (message-header HDR) + (let ((CODE (find (list (HDR 0) '*) MESSAGE-HEADERS match) 0)) + (list CODE (list (MESSAGE-HEADERS CODE 1) (HDR 1))))) + +;; Return a marshalled message +(define (message TYPE FLAGS HDRS BODY) + (pad-join 8 + (pack-data "yyyyuua(yv)" + (list (char "l") + (message-type-code TYPE) + (message-flags FLAGS) + (PROTOCOL-VERSION 0) ; Major version code + (length BODY) + (:serial++ (connection)) + (map message-header HDRS))) + BODY)) + +(define (method-body ARGS) + "") + +;; Invoke a method on an object via dbus +; (:invoke OBJ MEMBER INTERFACE FLAGS) +(define (invoke MEMBER INTERFACE (FLAGS 0)) + (or INTERFACE (setf INTERFACE (bus-name))) + (if (message 'METHOD_CALL FLAGS + (list (list 'PATH (%path)) + (list 'DESTINATION (bus-name)) + (list 'INTERFACE INTERFACE) + (list 'MEMBER MEMBER)) + (method-body (args))) + (begin + (let ((MSG $it) (BUFFER "") (RESULT "") (S (:%socket (connection)))) + (net-send S MSG) + (while (net-select S "r" 1000) + (net-receive S BUFFER 8192) + (extend RESULT BUFFER)) + BUFFER)) + nil + )) + +"lsp-dbus.lsp" diff --git a/lsp-util/Makefile b/lsp-util/Makefile new file mode 100644 index 0000000..526e46f --- /dev/null +++ b/lsp-util/Makefile @@ -0,0 +1,6 @@ +# Create the newlisp library foop.lsplib + +LSPSRC = foop.lsp misc.lsp + +lsp-util.a: ${LSPSRC} + ar r $@ $^ diff --git a/lsp-util/foop.lsp b/lsp-util/foop.lsp new file mode 100644 index 0000000..1724d3c --- /dev/null +++ b/lsp-util/foop.lsp @@ -0,0 +1,61 @@ +;; This newlisp module provides FOOP modelling support +;; +;; Functional Object-Oriented Programming (FOOP) is an abstraction +;; overlay using the newlisp context notion as similar to the class +;; notion in genuine object-oriented programming languages. This is +;; set out in newlisp by means of the representation principle that an +;; instance of a FOOP "class" (i.e. context) is a list headed by the +;; context itself, and followed by the "member values". +;; +;; FOOP further includes by the "method invocation" syntax where a +;; function is preceded by ':' and then followed by the instance +;; concerned before actual function arguments. That instance is then +;; stoved away as implicitly available via the (self) function, and +;; the member values accessible via index, e.g. the term (self 3) +;; refers to the third member of the instance. The self references are +;; destructively assignable with setf. +;; +;; This modelling support adds member name declaration together with +;; automatic getter and setter defintions. The (FOOP ...) term is used +;; for declaring member names in order. For example: +;; +;; (context 'MAIN:EX") +;; (FOOP a b c) +;; (define (EX:EX n) (list (context) (+ n 4) 3 2)) +;; +;; That would declare a FOOP context EX with instances having three +;; members named a, b and c. The declaratin results in a variable EX:. +;; whose value is (FOOP a b c), as well as three access functions for +;; each member: the member position index (.member), a getter +;; (%member) and a setter (!member V). +;; +;; As indicated in the example, (FOOP a b c) does not define the +;; "constructor". It only defines the access functions. + +(context 'FOOP) + +;; Helper function to make a new symbol for the context of S by +;; preceeding it with string P. +(define (name P S) (sym (string P (term S)) (prefix S))) + +;; (FOOP name ...) +; foop is a language extension to declare the field names of a FOOP +; object type, and thereby gain getter and setter functions with the +; naming formats (:%name obj) and (:!name obj value) respectively . +(define-macro (FOOP:FOOP) + (let ((K (sym "." (prefix (first (args))))) + (V (cons (context) (args))) + (I 0)) + (set K V) + (dolist (S (args)) + (letex ((GET (name "%" S)) + (SET (name "!" S)) + (IT (name "." S)) + (V (sym "V" (prefix S))) + (I (inc I))) + (define (IT) I) + (define (GET) (self I)) + (define (SET V) (setf (self I) V)))) + )) + +"foop.lsp" diff --git a/lsp-util/misc.lsp b/lsp-util/misc.lsp new file mode 100644 index 0000000..cf92d9c --- /dev/null +++ b/lsp-util/misc.lsp @@ -0,0 +1,16 @@ +(define (prog1 X) X) +(global 'prog1) + +(define (die N) + (when (args) (write-line 2 (join (map string (args)) " "))) + (exit N)) +(global 'die) + +;; Print binary byte as octal or as ASCII character [32-126] +(define (octal-byte x) + (if (and (> x 31) (< x 127)) (char x) (format "\\%o" x))) + +;; Print string as binary octals +(define (octals-string S) + (join (map octal-byte (unpack (dup "b" (length S)) S))) "") +(global 'octals-string 'octal-byte) -- 2.39.2