newLISP Fan Club

Quote

Code Select Expand



#!/usr/bin/newlisp
;
; ---------------------------------------------------
; RAW IMAP unseen messages checkup over ssl
; assumes openssl installed!
; runs only on Unix/Linux.
; use at own risk.
; copyleft version 0.3, newdep.
; ---------------------------------------------------
;

(setq imaps-server "imap.server.dom")       ; imap secure server name
(setq imaps-port   "993")               ; ssl secure port (993)
(setq unseen 0)                         ; unseen messages
;(setq user "ScoobyDoo")                ; pre-set username
(setq dont-check '( "Trash" ))          ; dont check these boxes for new mail. must match exactly


;; predefined functions
(define (clear-and-wait)
        (setq buffer "")
        (sleep 2000))           ; 2 seconds wait, give the server some slack.

(define (grab-while-peek)
        (clear-and-wait)
        (while (!= 0 (peek cltin)) (setq buffer (read-line cltin))))

(define (ask-user)
        (setq user "")
        (print "nIMAPS username: ")
        (setq user (read-line)))

(define (ask-pass)
        (setq pass "" c "")
        (print "IMAPS password: ")
        (while (!= (format "%c" (setq c (read-key))) "n")
        (push (format "%c" c) pass -1) (print "*"))
        (verify-input))

(define (ask)
        (ask-user)
        (ask-pass))

(define (verify-input)
        (print "nAre these oke? (y/n/Q)")
                (case (lower-case (char (read-key)))
                ("n" (ask)) ("y" true) ("q" (exit)) ("n" (verify-input))))


;; if already defined user then only ask password
(if user (ask-pass) (ask))
(println "n* Connecting to ssl://" imaps-server ":" imaps-port)


;; create pipes to communicate with openssl
(map set '(cltin imapsout) (pipe))
(map set '(imapsin cltout) (pipe))
;; process to the background, must exist!
(setq imaps (process (append (first (exec "which openssl")) { s_client -connect } imaps-server {:} imaps-port) imapsin imapsout))
(if-not imaps
        (begin
                (println "* Unable to process openssl!")
                (destroy imaps)
                (exit)))

;; wait for response on previous action
(grab-while-peek)
;; is it oke?
(if (find "* OK " buffer)
        (begin
                (println "* SSL connection setup")
                (write-line cltout (append {. LOGIN} { } user { "} pass {"})))

        (begin
                (println "* No IMAP SSL server!")
                (destroy imaps)
                (exit)))

;; wait for response on previous action
(grab-while-peek)
;; is it ok?
(if (find " OK Logged "  buffer)
        (begin
                (println "* Logged in.")
                (write-line cltout {. LIST "" "*" }))
        (begin
                (println "* Wrong authentication")
                (destroy imaps)
                (exit)))


;; wait for response on previous action        
(clear-and-wait)
;; grab boxes
(while (!= 0 (peek cltin)) (push (last (parse (read-line cltin))) boxes -1))

;; clear last " OK " responce from list
(if (= (last boxes) "completed.") (pop boxes -1))
;; pop the boxes from the list you dont want to be checked
(dolist (dont dont-check) (if (ref dont boxes) (pop boxes (ref dont boxes))))

;; checked every box for unseen messages.
(setq buffer "")
(dolist (box boxes)
        (write-line cltout (append {. STATUS} { } (string box) { } {(UNSEEN)}))
        (setq buffer (read-line cltin))
        (if (find "* STATUS" buffer) ( inc unseen (int ( (parse buffer) -2))))
        (setq buffer (read-line cltin))
)

;; Notify and goodbye
(println "* You have (" unseen ") unseen messages" )
(write cltout ". LOGOUT")
(destroy imaps)
(exit)