Модуль проверки прав ns_perm для AOL Server

Пример 1. В случае, когда у пользователя нет права stats, следующая строка прервет выполнение скрипта и отправит клиенту сообщение о том, что доступ запрещен (Forbidden).

ns_perm stats

Пример 2. Если у пользователя есть право stats, будет выведено сообщение Hello!. Выполнение скрипта продолжится.

ns_perm stats {
    ns_html::puts Hello!
}

Пример 3. Если у пользователя есть право stats, будет выведено сообщение Hello!, а иначе - сообщение Forbidden. Выполнение скрипта продолжится. Собственно, такое "изощренное" применение требуется достаточно редко.

if {[ns_perm stats {
    ns_html::puts Hello!
}] == 0} {
    ns_html::puts Forbidden
}

А вот и сама реализация:

#    Copyright 2009, Mobile Business Group
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see http://www.gnu.org/licenses/.

# использование args необходимо, т.к. пустое значение аргумента (тело скрипта) и его отсутствие это _разные_ ситуации
proc ns_perm {names args} {
    if {[ns_userkey exists system tasks_list] == 1} {
        # вытаскиваем работу с мьютексом из нижеследующего цикла для предотвращения лишних блокировок
        set tasks_list [ns_userkey get system tasks_list]
    } else {
        puts "Variable tasks_list does not found for session id=[ns_session id]"
        set tasks_list {}
    }
    if {$tasks_list ne {}} {
        # ищем хотя бы одно из указанных в аргументе names прав в списке прав пользователя
        foreach name $names {
            set ix [lsearch -exact $tasks_list $name]
            if {$ix >= 0} break
        }
    } else {
        set ix -1
    }
    if {[llength $args]==0 && $ix < 0} {
        # скрипт не указан, прав на продолжение работы нет
        ns_returnforbidden
        catch {uplevel 1 ns_adp_break}
        return 0
    } elseif {[llength $args]==0 && $ix >= 0} {
        # скрипт не указан, но права на продолжение работы есть
        return 1
    } elseif {[llength $args]==1 && $ix < 0} {
        # скрипт указан, но прав на его выполнение нет
        return 0
    } elseif {[llength $args]==1 && $ix >= 0} {
        # скрипт указан и есть права на его выполнение
        if {$args ne {}} {
        # тело скрипта не пустое
            uplevel 1 [lindex $args 0]
        }
        return 1
    }
    return -code error {Ошибка обработки аргументов}
}