grafana-sms-alert

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

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 }