Index: openacs-4/packages/acs-admin/www/auth/login-attempts-reset.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/login-attempts-reset.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-admin/www/auth/login-attempts-reset.tcl	1 Mar 2018 15:28:39 -0000	1.1
@@ -0,0 +1,27 @@
+ad_page_contract {
+    Flush login attempts
+
+    @author Günter Ernst (guenter.ernst@wu.ac.at)
+    @creation-date 2018-02-19
+    @cvs-id: $Id:
+} {
+    {attempt_key:notnull,token,multiple}
+}
+
+
+if {$attempt_key eq "all"} {
+    ::auth::login_attempts::reset_all
+} else {
+    foreach k $attempt_key {
+        ::auth::login_attempts::reset -login_attempt_key $attempt_key
+    }
+}
+
+ad_returnredirect "login-attempts"
+ad_script_abort
+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 4
+#    indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/acs-admin/www/auth/login-attempts.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/login-attempts.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-admin/www/auth/login-attempts.adp	1 Mar 2018 15:28:39 -0000	1.1
@@ -0,0 +1,11 @@
+<master>
+<property name="context">@context;literal@</property>
+<property name="doc(title)">@page_title;literal@</property>
+
+
+<h1>Login Attempts</h1>
+
+<p>View/Administrate all consecutive failed login attempts.</p>
+
+<listtemplate name="login_attempts"></listtemplate>
+
Index: openacs-4/packages/acs-admin/www/auth/login-attempts.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/login-attempts.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-admin/www/auth/login-attempts.tcl	1 Mar 2018 15:28:39 -0000	1.1
@@ -0,0 +1,67 @@
+ad_page_contract {
+    Administration page for failed login attempts
+
+    @author Günter Ernst (guenter.ernst@wu.ac.at)
+    @creation-date 2018-02-19
+    @cvs-id $Id:
+}
+
+set page_title "Login Attempts"
+set context [list [list "." "Authentication"] $page_title]
+
+
+set max_failed_login_attempts [parameter::get_from_package_key \
+                                  -parameter "MaxConsecutiveFailedLoginAttempts" \
+                                  -package_key "acs-authentication" \
+                                  -default 0]
+
+set auth_package_id [apm_package_id_from_key "acs-authentication"]
+set parameter_url [export_vars -base /shared/parameters { { package_id $auth_package_id } { return_url [ad_return_url] } }]
+
+::template::multirow create login_attempts attempt_key attempts locked_until flush_url
+
+foreach { attempt_key seconds attempts } [::auth::login_attempts::get_all] {
+    ::template::multirow append login_attempts $attempt_key $attempts [clock_to_ansi $seconds] [export_vars -base "login-attempts-reset" {attempt_key}]
+}
+
+
+list::create \
+    -name "login_attempts" \
+    -multirow "login_attempts" \
+    -actions [list "Flush all" "[export_vars -base "login-attempts-reset" {{attempt_key all}}]" "Clear all login attempts" \
+                   "Configure" "[export_vars -base "/shared/parameters" {{package_id $auth_package_id} {return_url [ad_return_url]}}]" "Configure"] \
+    -bulk_actions {"Flush selected attempts" "login-attempts-reset" "Flush selected attempts"} \
+    -bulk_action_method "post" \
+    -pass_properties {max_failed_login_attempts} \
+    -key attempt_key \
+    -elements {
+        attempt_key {
+            label "Attempt key"
+        }
+        attempts {
+            label "Attempts"
+            display_template {
+                <if @login_attempts.attempts@ gt @max_failed_login_attempts@>
+                    <span style="color:red;font-weight:bold;">@login_attempts.attempts;literal@</span>
+                </if><else>@login_attempts.attempts;literal@</else>
+            }
+        }
+        locked_until {
+            label "Lockout"
+        }
+        flush {
+            label "Actions"
+            sub_class narrow
+            display_template {
+                <a href="@login_attempts.flush_url;noquote@">Flush</a>
+            }
+        }
+    }
+
+
+ad_return_template
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 4
+#    indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/acs-authentication/tcl/authentication-procs-aolserver.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authentication-procs-aolserver.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs-aolserver.tcl	1 Mar 2018 15:28:39 -0000	1.1
@@ -0,0 +1,133 @@
+ad_library {
+
+    Provides the caching implementation of the brute force 
+    login prevention feature.
+
+    @author Guenter Ernst (guenter.ernst@wu.ac.at)
+    @creation-date 28 Feb 2018
+    @cvs-id $Id:
+}
+
+if {[ns_info name] eq "NaviServer"} {
+    return
+}
+
+#-------------------------------------------------------------------------
+# AOLserver implementation of the brute force 
+# login prevention feature caching procs
+#-------------------------------------------------------------------------
+
+namespace eval auth::login_attempts {}
+
+ad_proc -private ::auth::login_attempts::login_attempt_incr {
+    {-key:required}
+    {-max_age 21600}
+}  {
+    Increment the login attempts of a user.
+    The max_age is specified in seconds.
+} {
+    set key login-attempt-$key
+    set current_time [ns_time]
+
+    set cached_p [ns_cache get util_memoize $key pair]
+    if {$cached_p} {
+        set cache_time [lindex $pair 0]
+        if {$current_time - $cache_time > $max_age} {
+            ns_cache flush util_memoize $key
+            set cached_p 0
+        }
+    }
+
+    if {!$cached_p} {
+        set pair [ns_cache set util_memoize $key [list $current_time 1]]
+    } else {
+        ns_cache flush util_memoize $key
+        set old_value [lindex $pair 1]
+        set pair [ns_cache set util_memoize $key [list $current_time [incr old_value]]]
+    }
+    return [lindex $pair 1]
+}
+
+ad_proc -private ::auth::login_attempts::login_attempt_flush {
+    {-key:required}
+}  {
+    Flush the login attempts of a user.
+} {
+    ns_cache flush util_memoize login-attempt-$key
+}
+
+ad_proc -private ::auth::login_attempts::flush_all {}  {
+    Flush all login attempt counters
+} {
+    
+    set keys [ns_cache names util_memoize login-attempt-*]
+    
+    ns_cache flush util_memoize {*}$keys
+}
+
+ad_proc -private ::auth::login_attempts::get {
+    {-key:required}
+}  {
+    Get the current count of login attempts of a user.
+} {
+
+    set current_time [ns_time]
+    set max_age [parameter::get_from_package_key \
+                    -parameter "MaxConsecutiveFailedLoginAttemptsLockoutTime" \
+                    -package_key "acs-authentication" \
+                    -default 21600]
+
+    set cached_p [ns_cache get util_memoize login-attempt-$key pair]
+
+    if {$cached_p} {
+        lassign $pair cache_time count
+
+        if {$current_time - $cache_time > $max_age} {
+            ns_cache flush util_memoize $key
+            return 0
+        }
+
+        return $count
+
+    } else {
+        return 0
+    }
+}
+
+ad_proc -private ::auth::login_attempts::all_entries {}  {
+    Get all login attempts
+
+    @return list {key number_of_attempts timeout}
+} {
+
+    set result [list]
+    set current_time [ns_time]
+    set max_age [parameter::get_from_package_key \
+                    -parameter "MaxConsecutiveFailedLoginAttemptsLockoutTime" \
+                    -package_key "acs-authentication" \
+                    -default 21600]
+
+    foreach key [ns_cache names util_memoize login-attempt-*] {
+        set cached_p [ns_cache get util_memoize $key pair]
+
+        if {$cached_p} {
+            lassign $pair cache_time count
+
+            if {$current_time - $cache_time > $max_age} {
+                ns_cache flush util_memoize $key
+            } else {
+                lappend result [string range $key 14 end] $cache_time $count
+            }
+        }
+    }
+
+    return $result
+}
+
+
+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 4
+#    indent-tabs-mode: nil
+# End:
Index: openacs-4/packages/acs-authentication/tcl/authentication-procs-naviserver.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authentication-procs-naviserver.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs-naviserver.tcl	1 Mar 2018 15:28:39 -0000	1.1
@@ -0,0 +1,92 @@
+ad_library {
+
+    Provides the caching implementation of the brute force 
+    login prevention feature.
+
+    @author Guenter Ernst (guenter.ernst@wu.ac.at)
+    @creation-date 28 Feb 2018
+    @cvs-id $Id:
+}
+
+
+if {[ns_info name] ne "NaviServer"} {
+    return
+}
+
+#-------------------------------------------------------------------------
+# NaviServer implementation of the brute force 
+#    login prevention feature caching procs
+#-------------------------------------------------------------------------
+namespace eval auth::login_attempts {}
+
+ad_proc -private ::auth::login_attempts::login_attempt_incr {
+    {-key:required}
+    {-max_age 21600}
+}  {
+    Increment the login attempts of a user.
+    The max_age is specified in seconds.
+} {
+    return [ns_cache_incr -expires $max_age -- ns:memoize login-attempt-$key]
+}
+
+
+ad_proc -private ::auth::login_attempts::login_attempt_flush {
+    {-key:required}
+}  {
+    Flush the login attempts of a user.
+} {
+    ns_cache_flush ns:memoize login-attempt-$key
+}
+
+ad_proc -private ::auth::login_attempts::flush_all {}  {
+    Flush all login attempt counters.
+} {
+    ns_cache_flush -glob -- ns:memoize login-attempt-*
+}    
+
+ad_proc -private ::auth::login_attempts::get {
+    {-key:required}
+}  {
+    Get the current number of login attempts of a user.
+} {
+    if {[ns_cache get ns:memoize login-attempt-$key value]} {
+        return $value
+    } else {
+        return 0
+    }
+
+}
+
+ad_proc -private ::auth::login_attempts::all_entries {}  {
+    Get all login attempts
+
+    @return list {key number_of_attempts timeout ... }
+} {
+
+    set result [list]
+    set keys [ns_cache_keys ns:memoize]
+    set contents [lindex [ns_cache_stats -contents -- ns:memoize] 0]
+
+    foreach key $keys {size timeout} $contents {
+        if {![string match "login-attempt-*" $key]} {
+            continue
+        }
+
+        set value ""
+        ns_cache_get ns:memoize $key value
+
+        lappend result [string range $key 14 end] [ns_time seconds $timeout] $value
+    }
+
+    return $result
+
+}
+
+
+
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 4
+#    indent-tabs-mode: nil
+# End:
+