sms.fnl

(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))

(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)

(fn escape-readably [s]
  (s:gsub "%c" (fn [x] (string.format "\\u{%.3x}"  (string.byte x)))))

(fn tx [fd s]
  (write fd s)
  (print (.. ">>> " (escape-readably s)))
  (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)))))

(fn unicode->gsm [s]
  (s:gsub "." (fn [c] (chars (. gsm-char (string.byte c))))))

(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}€")))

(fn expect [fd pattern fail-pattern]
  (let [b (read fd 1024)]
    (if (> (# b) 0)
        (do
          (print (.. "<<< " (escape-readably b)))
          (if (string.find b pattern)
              (do (print "found" pattern) true)
              (and fail-pattern (string.find b fail-pattern))
              (error (.. "Expected " pattern ", got " (escape-readably b)))
              (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))))))

(test= (phone-number->hex "85291234567") "5892214365F7")
(test= (phone-number->hex "447785016005") "447758100650")

(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

(test= (message->pdu "85291234567" "It is easy to send text messages.") "01000B915892214365F7000021493A283D0795C3F33C88FE06CDCB6E32885EC6D341EDF27C1E3E97E72E")


(fn command [fd s]
  (tx fd (.. s "\r\n"))
  (expect fd "OK" "ERROR"))

(fn send-message [{: fd} number body]
  (let [pdu (message->pdu number (unicode->gsm body))
        payload (.. "00" pdu)]
    (doto fd
      (tx (.. "AT+CMGS=" (string.format "%d" (/ (# pdu) 2)) "\r\n"))
      (expect ">" "ERROR")
      (tx payload)
      (tx "\026\r\n")
      (expect "OK"))))

(fn new-sender [{: device : smsc : verbose}]
  (let [fd (fcntl.open device 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)))
    (doto fd
      (tcsetattr  0 termios)
      (tcdrain)

      (command "AT")
      (command "AT&F")                  ; revert to defaults
      (command "ATE0")                  ; disable command echo
      (command "AT+CMEE=1")              ;print CME errors
      (command (.. "AT+CSCA=\"" smsc "\",145\r\n")) ;set SMSC
      (command "AT+CMGF=0"))              ;SMS  PDU mode

    {:send send-message :device device :smsc smsc :fd fd}))

{  :new new-sender }