Shows off mail, command line, compiling and more.
(ql:quickload "cl-fad")
(ql:quickload "cl-smtp")
(ql:quickload "split-sequence")
(ql:quickload "command-line-arguments")
(ql:quickload :log4cl)
;
; helpers
;
(defmacro aif (test-form then-form &optional else-form)
"Anaphoric Macro
makes it possible to use value of if calculation without let assignment first"
`(let ((it ,test-form))
(if it ,then-form ,else-form)))
(defun find-part (part sequence)
"Find part as as substring in sequence elements, return first occurence or nil
(find-part \"abc\" (list \"x\" \"yabc\" \"z\")) ==> (list \"yabc\" \"z\")"
(member part sequence :test (lambda (a b) (search a b))))
(defun get-cmdline-opt (name)
"Handle arguments like -x y -p w
(get-cmdline-opt -x) => y"
(second (member name (command-line-arguments:get-command-line-arguments) :test 'equal )))
(defun split-and-lower (str)
"Lowercase and split around / and return all but first item"
(cdr (split-sequence:split-sequence #\/ (string-downcase str))))
(defun file-age-days (path)
(/ (- (get-universal-time) (file-write-date path)) (* 60.0 60.0 24.0) ) )
;
; scanning
;
(defun file-scan (path)
(let (files)
(defun scan-files (path)
(if (null path )
(log:info "no path supplied")
(cl-fad:walk-directory path 'check-file)))
(defun check-file (pathname)
(check-parts pathname (split-and-lower (namestring pathname))))
(defun check-parts (pathname parts)
(aif (find-part ".php" (cdr (find-part "media" parts)))
(prog ()
(if (< (file-age-days pathname) 20)
;(format t "found ~a in ~a~&" it pathname)
(push (namestring pathname) files)
))))
(scan-files path)
(return-from file-scan files)
))
(defun generate-report (files)
(format nil "Suspect files found:
~% ~{ - ~a
~% ~}" files))
(defun send-report (files recipient)
" Accepts a list of filenames. Builds an apropriate mail and send it "
(log:info "sending mail")
(cl-smtp:send-email "mail.infoserv.dk"
"msj@infoserv.dk" recipient
"Suspicious files" (generate-report files)
:extra-headers '(("Content-type" "text/html; charset=\"iso-8859-1\""))
:authentication '("msj@infoserv.dk" "******")
:port 366
)
)
;
; main
;
(defun main ()
(aif (get-cmdline-opt "--path")
(send-report (file-scan it) "msj@infoserv.dk")
(format t "supply a path using --path path")
)
(quit))
(log:config :daily "log.txt")
(main)
(defun compileme ()
(sb-ext:save-lisp-and-die "scandir" :executable t :toplevel 'main :purify t))
No comments:
Post a Comment