From b2c4972529b124f95c6a9fe6fe45bb87963d2d08 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Fri, 16 Sep 2022 00:30:54 +0100
Subject: [PATCH] switch to using PDU format

this means we can now send { } [ ] and other characters that
have multi-byte encoding in the gsm character set
---
 sms.fnl | 115 +++++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 98 insertions(+), 17 deletions(-)

diff --git a/sms.fnl b/sms.fnl
index 68e4b46..26dfa08 100644
--- a/sms.fnl
+++ b/sms.fnl
@@ -26,13 +26,12 @@
       (string.char i)
       (.. (string.char (rshift i 8)) (string.char (band i 0xff)))))
 
-(fn unicode-to-gsm [s]
+(fn unicode->gsm [s]
   (s:gsub "." (fn [c] (chars (. gsm-char (string.byte c))))))
 
 ;(print (escape-for-logging (unicode-to-gsm "hello")))
 ;(print (escape-for-logging (unicode-to-gsm "{he@llo}€")))
 
-
 (fn expect [fd pattern fail-pattern]
   (let [b (read fd 1024)]
     (if (> (# b) 0)
@@ -45,6 +44,88 @@
               (expect fd pattern)))
         nil)))
 
+(fn even? [x]
+  (= (% x 2) 0))
+
+(fn phone-number->hex [number]
+  (let [n (if (even? (# number)) number (.. number "F"))]
+    (n:gsub ".." (fn [s] (.. (s:sub 2 2) (s:sub 1 1))))))
+
+(assert (=  (phone-number->hex "447000123456") "440700214365"))
+(assert (=  (phone-number->hex "85291234567") "5892214365F7"))
+
+(fn mask [start end]
+  (let [width (+ 1 (- end start))]
+    (lshift (rshift 0xff (- 8 width)) start)))
+
+(fn bit-range [i start end]
+  (rshift (band i (mask start end)) start))
+
+
+(fn septets->hex [body]
+  ;; 0 body0[0-6] | body1[0] << 7
+  ;; 1 body1[1-6] | body2[0-1] << 6
+  ;; 2 body2[2-6] | body3[0-2] << 5
+  ;; 3 body3[3-6] | body4[0-3] << 4
+  ;; 4 body4[4-6] | body5[0-4] << 3
+  ;; 5 body5[5-6] | body6[0-5] << 2
+  ;; 6 body6[6]   | body7[0-6] << 1
+
+  ;; 7 body8[0-6] | body9[0] << 7
+  ;; 8 body9[1-6] | body10[0-1] << 6
+
+  ;; 14 body16[0-6] | body17[0] << 7
+
+  ;; for n<7,
+  ;; nth byte is bits n..6 of nth septet,
+  ;;  and bits 0..n of(n+1)th septet
+
+  ;; for n>=7,
+  ;; bits n%7..6 of floor(n+ (n/7))th septet
+  ;;  and 0..(n%7) of the next one
+
+  (let [bytes (math.floor (/ (* 7 (# body)) 8))
+        padded (.. body "\0")]
+    (var out "")
+    (for [index 0 bytes]
+      (let [n (% index 7)
+            in-index (math.floor (+ index (/ index 7)))
+            one (bit-range (string.byte padded (+ 1 in-index)) n 6)
+            two (bit-range (string.byte padded (+ 2 in-index)) 0 n)]
+        (set out (string.format "%s%.2X" out
+                                (bor one
+                                     (lshift two (- 7 n) )
+                                     )))))
+    out))
+
+(fn message->pdu [destination-number body]
+  ;; expects destination-number to be international but no leading +
+  ;; body is in gsm 7 bit alphabet
+  (let [fields
+        [
+         ;; sms-submit, allow dups, no vaidity period, no rpely path, no udh,
+         ;; no reply=path
+         "01"
+         ;; ME can choose message reference number
+         "00"
+         (string.format "%.2X" (# destination-number))
+         ;; destination-number is international (ITU E.164/E.163) without leading +
+         "91"
+         (phone-number->hex destination-number)
+         ;; protocol identifier
+         "00"
+         ;; data coding scheme (GSM 7 bit default alphabet)
+         "00"
+         (string.format "%.2X" (# body))
+         (septets->hex body)
+         ]]
+    (table.concat fields)))
+
+;; per worked example at https://www.developershome.com/sms/cmgsCommand4.asp
+
+(assert (= (message->pdu "85291234567" "It is easy to send text messages.") "01000B915892214365F7000021493A283D0795C3F33C88FE06CDCB6E32885EC6D341EDF27C1E3E97E72E"))
+
+
 (fn command [fd s]
   (tx fd (.. s "\r\n"))
   (expect fd "OK" "ERROR"))
@@ -62,23 +143,23 @@
     (tcsetattr fd 0 termios)
 
     (tcdrain fd)
-    (doto fd
-      (command "AT")
-      (command "AT&F")                  ; revert to defaults
-      (command "ATE0")                  ; disable command echo
-      (command "AT+CMEE=1")              ;print CME errors
-      (command "AT+CMGF=1")              ;SMS text mode (vs. PDU mode)
-      (command "AT+CSCS=\"GSM\"")        ; default character set
-      (command "AT+CSMP=17,12,0,0")      ; message valid for 12*5 minutes
-      (command "AT+CSCA=\"+447958879879\",145\r\n") ;set SMSC
 
-      (tx (.. "AT+CMGS=\"" number "\"\r\n"))
-      (expect ">")
+    (let [pdu (message->pdu number (unicode->gsm body))
+          payload (.. "00" pdu)]
+      (doto fd
+        (command "AT")
+        (command "AT&F")                  ; revert to defaults
+        (command "ATE0")                  ; disable command echo
+        (command "AT+CMEE=1")              ;print CME errors
+        (command "AT+CSCA=\"+447958879879\",145\r\n") ;set SMSC
+        (command "AT+CMGF=0")              ;SMS  PDU mode
 
-      ;;      (tx (unicode-to-gsm body))
-      (tx body)
-      (tx "\026\r\n")
-      (expect "OK"))))
+        (tx (.. "AT+CMGS=" (string.format "%d" (/ (# pdu) 2)) "\r\n"))
+        (expect ">" "ERROR")
+        (tx payload)
+        (tx "\026\r\n")
+        (expect "OK")))))
 
+;(send-sms "447000123456" "It is never {easy} to [send] text messages.")
 
 {  :send send-sms }