sms.fnl (5636B)
1 (local fcntl (require "posix.fcntl")) 2 (local posix (require "posix")) 3 (local { : read : write } (require "posix.unistd")) 4 (local {: tcgetattr : tcsetattr : tcdrain 5 : CLOCAL : CREAD 6 : ICANON : ECHO : ECHOE : ISIG 7 : OPOST 8 } (require "posix.termio")) 9 (local { : nanosleep } (require "posix.time")) 10 (local { : view } (require "fennel")) 11 12 (local gsm-char (require :unicode-to-gsm)) 13 14 (macro test= [expr expected] 15 `(let [a# ,expr 16 e# ,expected] 17 (if (not (= a# e#)) 18 (assert false (.. "expected " ,(view expr) " = " e# 19 ", actual " a#))))) 20 21 (fn escape-readably [s] 22 (s:gsub "%c" (fn [x] (string.format "\\u{%.3x}" (string.byte x))))) 23 24 (fn log-xfer [direction message] 25 (when _G.modem-spew 26 (_G.modem-spew:write direction " " (escape-readably message) "\n")) 27 message) 28 29 (fn tx [fd s] 30 (write fd s) 31 (log-xfer :>>> s) 32 (nanosleep {:tv_sec 0 :tv_nsec (* 10 1000 1000)})) 33 34 (fn chars [i] 35 (if (not i) 36 "" 37 (< i 256) 38 (string.char i) 39 (.. (string.char (rshift i 8)) (string.char (band i 0xff))))) 40 41 (fn unicode->gsm [s] 42 (s:gsub "." (fn [c] (chars (. gsm-char (string.byte c)))))) 43 44 (test= (unicode->gsm "abc123") "abc123") 45 (test= (unicode->gsm "abc{123}") "abc\x1b(123\x1b)") 46 47 (fn expect [fd pattern fail-pattern] 48 (let [b (read fd 1024)] 49 (if (> (# b) 0) 50 (if (string.find (log-xfer :<<< b) pattern) 51 (log-xfer :!!! pattern) 52 (and fail-pattern (string.find b fail-pattern)) 53 (error (.. "Expected " pattern ", got " (escape-readably b))) 54 (expect fd pattern fail-pattern)) 55 nil))) 56 57 (fn command [fd s] 58 (tx fd (.. s "\r\n")) 59 (expect fd "OK" "ERROR")) 60 61 62 (fn even? [x] 63 (= (% x 2) 0)) 64 65 (fn phone-number->hex [number] 66 (let [n (if (even? (# number)) number (.. number "F"))] 67 (n:gsub ".." (fn [s] (.. (s:sub 2 2) (s:sub 1 1)))))) 68 69 (test= (phone-number->hex "85291234567") "5892214365F7") 70 (test= (phone-number->hex "447785016005") "447758100650") 71 72 73 (fn bit-range [i start end] 74 (let [width (+ 1 (- end start)) 75 mask (lshift (rshift 0xff (- 8 width)) start)] 76 (rshift (band i mask) start))) 77 78 (fn septets->hex [body] 79 ;; 0 body0[0-6] | body1[0] << 7 80 ;; 1 body1[1-6] | body2[0-1] << 6 81 ;; 2 body2[2-6] | body3[0-2] << 5 82 ;; 3 body3[3-6] | body4[0-3] << 4 83 ;; 4 body4[4-6] | body5[0-4] << 3 84 ;; 5 body5[5-6] | body6[0-5] << 2 85 ;; 6 body6[6] | body7[0-6] << 1 86 87 ;; 7 body8[0-6] | body9[0] << 7 88 ;; 8 body9[1-6] | body10[0-1] << 6 89 90 ;; 14 body16[0-6] | body17[0] << 7 91 92 ;; for n<7, 93 ;; nth byte is bits n..6 of nth septet, 94 ;; and bits 0..n of(n+1)th septet 95 96 ;; for all n including n>=7, 97 ;; bits n%7..6 of floor(n+ (n/7))th septet 98 ;; and 0..(n%7) of the next one 99 100 (let [bytes (math.floor (/ (* 7 (# body)) 8)) 101 padded (.. body "\0")] 102 (var out "") 103 (for [index 0 bytes] 104 (let [n (% index 7) 105 in-index (math.floor (+ index (/ index 7))) 106 one (bit-range (string.byte padded (+ 1 in-index)) n 6) 107 two (bit-range (string.byte padded (+ 2 in-index)) 0 n)] 108 (set out (string.format "%s%.2X" out 109 (bor one 110 (lshift two (- 7 n) ) 111 ))))) 112 out)) 113 114 (fn message->pdu [destination-number body] 115 ;; expects destination-number to be international but no leading + 116 ;; body is in gsm 7 bit alphabet 117 (let [fields 118 [ 119 ;; sms-submit, allow dups, no vaidity period, no rpely path, no udh, 120 ;; no reply=path 121 "01" 122 ;; ME can choose message reference number 123 "00" 124 (string.format "%.2X" (# destination-number)) 125 ;; destination-number is international (ITU E.164/E.163) without leading + 126 "91" 127 (phone-number->hex destination-number) 128 ;; protocol identifier 129 "00" 130 ;; data coding scheme (GSM 7 bit default alphabet) 131 "00" 132 (string.format "%.2X" (# body)) 133 (septets->hex body) 134 ]] 135 (table.concat fields))) 136 137 ;; per worked example at https://www.developershome.com/sms/cmgsCommand4.asp 138 139 (test= (message->pdu "85291234567" "It is easy to send text messages.") "01000B915892214365F7000021493A283D0795C3F33C88FE06CDCB6E32885EC6D341EDF27C1E3E97E72E") 140 141 142 (fn send-message [{: fd} number body] 143 (let [pdu (message->pdu number (unicode->gsm body)) 144 payload (.. "00" pdu)] 145 (doto fd 146 (tx (.. "AT+CMGS=" (string.format "%d" (/ (# pdu) 2)) "\r\n")) 147 (expect ">" "ERROR") 148 (tx payload) 149 (tx "\026") 150 (expect "OK")))) 151 152 (fn new-sender [{: device : smsc : verbose}] 153 (let [fd (fcntl.open device posix.O_RDWR) 154 termios (tcgetattr fd)] 155 (tset termios :cflag (bor termios.cflag CLOCAL CREAD)) 156 (tset termios :lflag (band termios.lflag 157 (bnot ICANON) 158 (bnot ECHO) 159 (bnot ECHOE) 160 (bnot ISIG))) 161 (tset termios :oflag (band termios.oflag ( bnot OPOST))) 162 (doto fd 163 (tcsetattr 0 termios) 164 (tcdrain) 165 166 (command "AT") ; hello ? 167 (command "AT&F") ; revert to defaults 168 (command "ATE0") ; disable command echo 169 (command "AT+CMEE=1") ; print CME errors 170 (command (.. "AT+CSCA=\"" smsc "\",145")) ; set SMSC 171 (command "AT+CMGF=0")) ; expect SMS data in PDU mode 172 173 {:send send-message :device device :smsc smsc :fd fd})) 174 175 { :new new-sender :verbose false }