blob: a205b452d840aff064accaacd43687dca68326f3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#!/depot/path/tclsh
package require cgi
cgi_eval {
source example.tcl
set cardtypes {
"American Express"
"Carte Blanche"
"Diners Card"
"Discover"
"Enroute"
"JCB"
"Mastercard"
"Novus"
"Visa"
}
# My own version of the LUHN check
proc LUHNFormula {cardnumber} {
if {0==[regexp "(.*)(.)$" $cardnumber dummy cardnumber check]} {
user_error "No card number entered"
}
set evenodd [expr [string length $cardnumber] % 2]
set sum 0
foreach digit [split $cardnumber ""] {
incr sum $digit
if {$evenodd} {
incr sum [lindex {0 1 2 3 4 -4 -3 -2 -1 0} $digit]
}
set evenodd [expr !$evenodd]
}
set computed [expr {(10 - ($sum % 10)) % 10}]
if {$computed != $check} {
user_error "Invalid card number. (Failed LUHN test - try changing last digit to $computed.)"
}
}
# generate digit patterns of length n
proc d {n} {
for {set i 0} {$i < $n} {incr i} {
append buf {[0-9]}
}
return $buf
}
cgi_input
cgi_title "Check Credit Card"
cgi_body {
if {0 == [catch {cgi_import cardtype}]} {
if {[catch {cgi_import cardnumber}]} {
user_error "No card number entered"
}
# Save original version for clearer diagnostics
set originalcardnumber [cgi_quote_html $cardnumber]
if {[catch {cgi_import expiration}]} {
user_error "You must enter an expiration."
}
if {-1 == [lsearch $cardtypes $cardtype]} {
user_error "Unknown card type: $cardtype"
}
# Remove any spaces or dashes in card number
regsub -all "\[- ]" $cardnumber "" cardnumber
# Make sure that only digits are left
if {[regexp "\[^0-9]" $cardnumber invalid]} {
user_error "Invalid character ([cgi_quote_html $invalid]) in credit card number: $originalcardnumber"
}
if {$cardtype != "Enroute"} {
LUHNFormula $cardnumber
}
# Verify correct length and prefix for each card type
switch $cardtype {
Visa {
regexp "^4[d 12]([d 3])?$" $cardnumber match
} Mastercard {
regexp "^5\[1-5][d 14]$" $cardnumber match
} "American Express" {
regexp "^3\[47][d 13]$" $cardnumber match
} "Diners Club" {
regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match
} "Carte Blanche" {
regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match
} Discover {
regexp "^6011[d 12]$" $cardnumber match
} Enroute {
regexp "^(2014|2149)[d 11]$" $cardnumber match
} JCB {
regexp "^(2131|1800)[d 11]$" $cardnumber match
regexp "^3(088|096|112|158|337|528)[d 12]$" $cardnumber match
} Novus {
if {[string length $cardnumber] == 16} {
set match 1
}
}
}
if 0==[info exists match] {
user_error "Invalid card number: $originalcardnumber"
}
h3 "Your card appears to be valid. Thanks!"
return
}
cgi_form creditcard {
h3 "Select a card type, enter the card number and expiration."
puts "Card type: "
cgi_select cardtype {
foreach t $cardtypes {
cgi_option $t
}
}
puts "[nl]Card number: "
cgi_text cardnumber=
puts "(blanks and dashes are ignored)"
puts "[nl]Expiration: "
cgi_text expiration=
br
submit_button "=Confirm purchase"
reset_button
h5 "This script will perform all of the known syntactic
checks for each card type but will not actually contact
a credit bureau. The expiration field is not presently
checked at all."
}
}
}
|
