fork download
copy 
  1.  
  2. (defvar *password-judge-list* nil)
  3. (defvar *password-list* (list "passw0rd" "abc123" "qwerty"))
  4. (defvar *word-list* (list "password" "cat" "baseball"))
  5.  
  6. (defmacro push-password-judge (var test judge reason)
  7.   `(push #'(lambda (,var) (if ,test (values ,judge ,reason) :passed)) *password-judge-list*))
  8.  
  9. (push-password-judge p (<= (length p) 5) :bad :too-short)
  10. (push-password-judge p (loop for prev-c = nil then c
  11. 			     for c across p
  12. 			     for n = 0 then (if (eql c prev-c) (1+ n) 1)
  13. 			     when (= n 3) do (return t)
  14. 			     finally (return nil))
  15. 		     :bad
  16. 		     :consecutive-three-letter)
  17. ;;;; regular-sequence, not implemented
  18. (push-password-judge p (member p *password-list* :test #'string=) :bad :same-password)
  19. (push-password-judge p (member p *word-list* :test #'string=) :bad :common-word)
  20. (push-password-judge p (loop for w in *word-list*
  21. 			     when (search w p) do (return t)
  22. 			     finally (return nil))
  23. 		     :not-good
  24. 		     :contains-common-word)
  25. (push-password-judge p (every #'alpha-char-p p) :not-good :all-alpha)
  26. (push-password-judge p (every #'digit-char-p p) :bad :all-digit)
  27. ;;;; looks-date, not implemented
  28.  
  29. (defun judge-password (p)
  30.   (let ((judge :passed)
  31. 	(reasons nil))
  32.     (dolist (judge-fn *password-judge-list*)
  33.       (multiple-value-bind (j r) (funcall judge-fn p)
  34. 			   (when r (push r reasons))
  35. 			   (when (or (eq judge :passed)
  36. 				   (and (eq judge :not-good) (eq j :bad)))
  37. 			       (setf judge j))))
  38.     (values judge reasons)))
  39.  
  40. (defvar *ps* (list "ac" "3AAA1567" "passw0rd" "baseball" "a4cat7R" "kreplm" "473546"))
  41. (dolist (p *ps*)
  42.   (multiple-value-bind (j r) (judge-password p)
  43. 		       (if (eq j :passed)
  44. 			   (format t "~a:~a~%" p j)
  45. 			 (format t "~a:~a ~a~%" p j r))))
  46.  
Success #stdin #stdout 0.01s 25912KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
ac:BAD (TOO-SHORT ALL-ALPHA)
3AAA1567:BAD (CONSECUTIVE-THREE-LETTER)
passw0rd:BAD (SAME-PASSWORD)
baseball:BAD (COMMON-WORD CONTAINS-COMMON-WORD ALL-ALPHA)
a4cat7R:NOT-GOOD (CONTAINS-COMMON-WORD)
kreplm:NOT-GOOD (ALL-ALPHA)
473546:BAD (ALL-DIGIT)
https://ideone.com/K7iXjl
language:
Common Lisp (sbcl 1.4.16)
created:
3 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!