2022-09-15 21:08:06 +00:00
(local fcntl (require "posix.fcntl"))
(local posix (require "posix"))
(local { : read : write } (require "posix.unistd"))
(local {: tcgetattr : tcsetattr : tcdrain
: CLOCAL : CREAD
: ICANON : ECHO : ECHOE : ISIG
: OPOST
} (require "posix.termio"))
(local { : nanosleep } (require "posix.time"))
(local { : view } (require "fennel"))
(local gsm-char (require :unicode-to-gsm))
2022-09-16 09:27:40 +00:00
(macro test= [expr expected]
`(let [a# ,expr
e# ,expected]
(if (not (= a# e#))
(assert false (.. "expected " ,(view expr) " = " e#
", actual " a#)))))
(test= (+ 5 4) 9)
2022-09-16 14:50:45 +00:00
(fn escape-readably [s]
(s:gsub "%c" (fn [x] (string.format "\\u{%.3x}" (string.byte x)))))
2022-09-15 21:08:06 +00:00
(fn tx [fd s]
(write fd s)
2022-09-16 14:50:45 +00:00
(print (.. ">>> " (escape-readably s)))
2022-09-15 21:08:06 +00:00
(nanosleep {:tv_sec 0 :tv_nsec (* 10 1000 1000)}))
(fn chars [i]
(if (not i)
""
(< i 256)
(string.char i)
(.. (string.char (rshift i 8)) (string.char (band i 0xff)))))
2022-09-15 23:30:54 +00:00
(fn unicode->gsm [s]
2022-09-15 21:08:06 +00:00
(s:gsub "." (fn [c] (chars (. gsm-char (string.byte c))))))
2022-09-16 14:50:45 +00:00
(test= (unicode->gsm "abc123") "abc123")
(test= (unicode->gsm "abc{123}") "abc\x1b(123\x1b)")
;(print (escape-readably(unicode-to-gsm "hello")))
;(print (escape-readably(unicode-to-gsm "{he@llo}€")))
2022-09-15 21:08:06 +00:00
2022-09-15 21:17:18 +00:00
(fn expect [fd pattern fail-pattern]
2022-09-15 21:08:06 +00:00
(let [b (read fd 1024)]
(if (> (# b) 0)
(do
2022-09-16 14:50:45 +00:00
(print (.. "<<< " (escape-readably b)))
2022-09-15 21:08:06 +00:00
(if (string.find b pattern)
(do (print "found" pattern) true)
2022-09-15 21:17:18 +00:00
(and fail-pattern (string.find b fail-pattern))
2022-09-16 14:50:45 +00:00
(error (.. "Expected " pattern ", got " (escape-readably b)))
2022-09-15 21:08:06 +00:00
(expect fd pattern)))
nil)))
2022-09-15 23:30:54 +00:00
(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))))))
2022-09-16 09:27:40 +00:00
(test= (phone-number->hex "85291234567") "5892214365F7")
(test= (phone-number->hex "447785016005") "447758100650")
2022-09-15 23:30:54 +00:00
(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
2022-09-16 09:27:40 +00:00
(test= (message->pdu "85291234567" "It is easy to send text messages.") "01000B915892214365F7000021493A283D0795C3F33C88FE06CDCB6E32885EC6D341EDF27C1E3E97E72E")
2022-09-15 23:30:54 +00:00
2022-09-15 21:17:18 +00:00
(fn command [fd s]
(tx fd (.. s "\r\n"))
(expect fd "OK" "ERROR"))
2022-09-15 21:08:06 +00:00
(fn send-sms [number body]
(let [fd (fcntl.open "/dev/serial/by-id/usb-HUAWEI_HUAWEI_HiLink-if00-port0" posix.O_RDWR)
termios (tcgetattr fd)]
(tset termios :cflag (bor termios.cflag CLOCAL CREAD))
(tset termios :lflag (band termios.lflag
(bnot ICANON)
(bnot ECHO)
(bnot ECHOE)
(bnot ISIG)))
(tset termios :oflag (band termios.oflag ( bnot OPOST)))
(tcsetattr fd 0 termios)
2022-09-15 21:17:18 +00:00
2022-09-15 21:08:06 +00:00
(tcdrain fd)
2022-09-15 23:30:54 +00:00
(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 (.. "AT+CMGS=" (string.format "%d" (/ (# pdu) 2)) "\r\n"))
(expect ">" "ERROR")
(tx payload)
(tx "\026\r\n")
(expect "OK")))))
2022-09-15 21:08:06 +00:00
{ :send send-sms }