1:- module(login_validate, [
2 validate_js//0,
3 valid/2
4 ]).
11:- use_module(library(http/html_write)). 12:- use_module(library(http/js_write)). 13:- use_module(library(pcre)). 14
15:- setting(identity:constraints,
16 dict,
17 _{
18 email: _{ min: 4,
19 max: 128,
20 regex: '^[A-Za-z0-9\\-_\\+\\.]+@(([A-Za-z0-9\\-_\\+]+)\\.)+[A-Za-z0-9]+$',
21 warn: 'Must be a valid email address'
22 },
23 uname: _{ min: 4,
24 max: 128,
25 regex: '^[A-Za-z0-9\\-_\\+\\.]+$',
26 warn: 'User name must be 4-128 characters from a-z, A-Z, 0-9, - and _'
27 },
28 passwd: _{ min: 4,
29 max: 999,
30 regex: '^(?=.{8,999}$)(?=.*[a-z])(?=.*[A-Z])(?=.*\\d)(?=.*[^A-Za-z0-9]).*$',
31 warn: 'Password must be at least 8 long, and contain a capital letter, a lowercase letter, a digit, and a special symbol like !@#$%^&*()'
32 },
33 passwd2: _{
34 min: 4,
35 max: 999,
36 regex: '^(?=.{8,999}$)(?=.*[a-z])(?=.*[A-Z])(?=.*\\d)(?=.*[^A-Za-z0-9]).*$',
37 warn: 'Field below must match password'
38 }
39 },
40 "A dict with the constraints to apply to the registration form"
41). 42
43constraints(X) :-
44 setting(identity:constraints, X).
45
46% You're a wonderful bit of javascript. You're completely
47% valid, and perfect just as you are.
48% I feel your pain.
49%
50validate_js -->
51 { constraints(Constraints) },
52 html([\js_script({|javascript(Constraints)||
53 const loginConstraints = Constraints;
54
55 const loginTimers = {
56 email: null,
57 passwd: null,
58 uname: null,
59 passwd2: null
60 };
61
62 document.getElementById("emailwarn").innerHTML =
63 loginConstraints['email'].warn;
64 document.getElementById("unamewarn").innerHTML =
65 loginConstraints['uname'].warn;
66 document.getElementById("passwdwarn").innerHTML =
67 loginConstraints['passwd'].warn;
68 document.getElementById("passwd2warn").innerHTML =
69 loginConstraints['passwd2'].warn;
70
71 function validateIdentity(Element) {
72 loginTimers[Element.name] = null;
73 console.log(Element.value);
74 console.log(Element.name);
75 var c = loginConstraints[Element.name];
76
77 if( Element.name == "passwd2") {
78 var pw = document.getElementById("passwd").value;
79 var pw2 = Element.value;
80 console.log(pw);
81 console.log(pw2);
82
83 if(pw === pw2) {
84 Element.classList.remove("error");
85 document.getElementById(Element.name + "warn").classList.remove('warn');
86 } else {
87 Element.classList.add("error");
88 document.getElementById(Element.name + "warn").classList.add('warn');
89 }
90 return;
91 }
92
93 var patt = new RegExp(c.regex);
94
95 if(Element.value.length < c.min ||
96 Element.value.length > c.max ||
97 patt.exec(Element.value) == null
98 ) {
99 Element.classList.add("error");
100 document.getElementById(Element.name + "warn").classList.add('warn');
101 } else {
102 Element.classList.remove("error");
103 document.getElementById(Element.name + "warn").classList.remove('warn');
104 }
105 }
106
107 function doValidation(Element) {
108 if(loginTimers[Element.name] != null) {
109 clearTimeout(loginTimers[Element.name]);
110 }
111 loginTimers[Element.name] = setTimeout(
112 () => validateIdentity(Element),
113 600);
114 }
115 |}),
116 style('.error { border: 3px solid #FF0000; }\n.warning { display: none; }\n.warning.warn { display: block;\ncolor: #aa6666; }')
117 ]).
119valid(FieldName=Value, Status) :-
120 constraints(C),
121 string_length(Value, L),
122 C.FieldName.min > L,
123 !,
124 format(atom(Status), '~w is too short, must be at least ~w~n',
125 [FieldName, C.FieldName.min]).
126valid(FieldName=Value, Status) :-
127 constraints(C),
128 string_length(Value, L),
129 C.FieldName.max < L,
130 !,
131 format(atom(Status), '~w is too long, must be at most ~w~n',
132 [FieldName, C.FieldName.max]).
133valid(FieldName=Value, Status) :-
134 constraints(C),
135 \+ re_match(C.FieldName.regex, Value),
136 !,
137 format(atom(Status), '~w must have blah blah ~w~n',
138 [FieldName, C.FieldName.max]).
139valid(_=_, ok).
140
Form validation of username, password, and email
This module provides both client and server side validation.
/