如何在此 CGI::Application 中一次只允许一名用户？

Question

我已经使用 this 教程制作了一个网站，但我希望只允许一个用户可以随时登录。

我想这个更改应该在我包含的 Login.pm 中进行，但我不知道在哪里放置这个限制。

更新

基于 scorpio17 的解决方案，如果用户记得单击注销，我现在只能登录一个用户。

现在的问题是当会话超时时 $can_login 状态如何改变。

这是更新的功能。

sub logout : Runmode {
    my $self = shift;
    if ($self->authen->username) {
    $self->authen->logout;
    $self->session->delete; # Delete current session
    }

    # get state of can_login file
    my $file = "lock-can_login.txt";
    open my $fh, '+<', $file or die "can't open $file in update mode: $!\n";
    flock($fh, LOCK_EX) or die "couldn't get lock: $!\n";

    # 1 means a new user can login
    my $can_login = <$fh>;
    chomp $can_login;

    # allow others to login now
    $can_login = !$can_login;

    # write
    seek $fh, 0, 0;
    print $fh "$can_login\n";
    truncate($fh, tell($fh));
    close $fh;

    return $self->redirect($self->query->url);
}

sub one_user {
    my $self = shift;

    # get state of can_login file
    my $file = "lock-can_login.txt";
    open my $fh, '+<', $file or die "can't open $file in update mode: $!\n";
    flock($fh, LOCK_EX) or die "couldn't get lock: $!\n";

    # 1 means a new user can login
    my $can_login = <$fh>;
    chomp $can_login;

    if ($self->authen->is_authenticated && $can_login) {
    # prevent others from logging in
    $can_login = !$can_login;
    } else {
    $self->authen->logout;
    #and redirect them to a page saying "there can be only one!"
    }

    # write
    seek $fh, 0, 0;
    print $fh "$can_login\n";
    truncate($fh, tell($fh));
    close $fh;
}

有人能弄清楚吗？

package MyLib::Login;

use strict;

#use lib '/usr/lib/perl5/vendor_perl/5.8.8/';

use base 'CGI::Application';

# shorter URLs
# extract the desired run mode from the PATH_INFO environment variable.
use CGI::Application::Plugin::AutoRunmode;

# wrapper for DBI
#use CGI::Application::Plugin::DBH(qw/dbh_config dbh/);

# a wrapper around CGI::Session.
# maintain state from one page view to the next (provides persistent data).
use CGI::Application::Plugin::Session;

# logging in and out.
# Authentication allows to identify individual users.
use CGI::Application::Plugin::Authentication;

# external redirects in CGI::Application
use CGI::Application::Plugin::Redirect;

# read parameters from config file
use CGI::Application::Plugin::ConfigAuto(qw/cfg/);

# encrypt passphrases
use Digest::MD5 qw(md5_hex);

# authenticate against NIS/LDAP server
use Authen::Simple::LDAP;


sub setup {
    my $self = shift;

    $self->mode_param(
    path_info => 1,         # tell CGI::Application to parse the PATH_INFO environment variable
    param     => 'rm',
    );
}

# most of the initialization is done here
sub cgiapp_init {
    my $self = shift;

    # read config file and store name-value pairs in %CFG
    my %CFG = $self->cfg;

    # where to look for templete files
    $self->tmpl_path(['./templates']);

    # save session data in mysql
    $self->session_config(
    # store sessions in /tmp as files
    CGI_SESSION_OPTIONS => [ "driver:File", $self->query, {Directory=>'/tmp'} ],

    DEFAULT_EXPIRY => '+10m',   # default expiration time for sessions
    );

    # configure authentication parameters
    $self->authen->config(
    DRIVER => [ 'Authen::Simple::LDAP',
            host   => 'ldaps://nms.imm.dtu.dk/dc=ldap,dc=imm,dc=dtu,dc=dk',
            basedn => 'OU=people,DC=ldap,DC=imm,DC=dtu,DC=dk',
    ],

    STORE                => 'Session',          # save login state inside a session
                                                    # If a user is not logged in, but tries to access a
                                                    # protected page, the Authentication plugin will
                                                    # automatically redirect the user to the login page.
                                                    # Once the user enters a valid username and
                                                    # passsword, they get redirected back to the
                                                    # protected page they originally requested.
    LOGOUT_RUNMODE       => 'logout',           # method to use for logging out when session expires

# uncomment the next 3 lines to enable custom build login prompt
#   LOGIN_RUNMODE        => 'login',
#   POST_LOGIN_RUNMODE   => 'okay',             # run mode that gets called after a user successfully logs in
                                                    # figures out which run mode (page) the user really wanted to
                                                    # see, then redirects the browser to that page using http
                                                    # (not https).

#   RENDER_LOGIN         => \&my_login_form,    # generate a login form. Authentication plugin comes with a default 
    );

    # define runmodes (pages) that require successful login:
    # The Login.pm module doesn't define any content - all of the actual web pages are in Simple.pm.
    # 'mustlogin' page is a place-holder. It's a dummy page that forces you to login, but immediately redirects
    # you back to the default start page (usually the index page).
    $self->authen->protected_runmodes('mustlogin');
}


# define mustlogin runmode
sub mustlogin : Runmode {
    my $self = shift;
    my $url = $self->query->url;
    return $self->redirect($url);
}


# switch from https to http. It assumes that the target run mode is stored in a cgi parameter named
# 'destination', but if for some reason this is not the case, it will default back to the index page.
sub okay : Runmode {
    my $self = shift;

    my $url = $self->query->url;
#  my $user = $self->authen->username;
    my $dest = $self->query->param('destination') || 'index';

    if ($url =~ /^https/) {
    $url =~ s/^https/http/;
    }

    return $self->redirect("$url/$dest");
}

# displays the login form
# But first, it checks to make sure you're not already logged in, and second, it makes sure you're connecting with https. If you try to access the login page with http, it will automatically redirect you using https.
sub login : Runmode {
    my $self = shift;
    my $url = $self->query->url;

    my $user = $self->authen->username;
    # is user logged in?
    if ($user) {
    my $message = "User $user is already logged in!";
    my $template = $self->load_tmpl('default.html');
    $template->param(MESSAGE => $message);
    $template->param(MYURL => $url);
    return $template->output;
    } else {
    my $url = $self->query->self_url;
    unless ($url =~ /^https/) {
            $url =~ s/^http/https/;
        return $self->redirect($url);
    }
    return $self->my_login_form;
    }
}

# generate custom login. See templates/login_form.html
sub my_login_form {
    my $self = shift;
    my $template = $self->load_tmpl('login_form.html');

    (undef, my $info) = split(/\//, $ENV{'PATH_INFO'});
    my $url = $self->query->url;

    # 'destination' contains the URL of the page to go to once the user has successfully logged in

    # try to get a value for 'destination' from the CGI query object (in case it was passed as a hidden variable)
    my $destination = $self->query->param('destination');

    # If failed to get from CGI query object, try get destination from PATH_INFO environment variable
    # in case it's being passed as part of the URL
    unless ($destination) {
    if ($info) {
        $destination = $info;
    } else {
        # default to index page
        $destination = "index";
    }
    }

    my $error = $self->authen->login_attempts;

    # insert values into the template parameters
    $template->param(MYURL => $url);
    $template->param(ERROR => $error);
    $template->param(DESTINATION => $destination);

    # generate final html
    return $template->output;
}
# logout method
sub logout : Runmode {
    my $self = shift;
    if ($self->authen->username) {
    $self->authen->logout;
    $self->session->delete; # Delete current session
    }
    return $self->redirect($self->query->url);
}

# error runmode / page
sub myerror : ErrorRunmode {
    my $self = shift;
    my $error = shift;
    my $template = $self->load_tmpl("default.html");
    $template->param(NAME => 'ERROR');
    $template->param(MESSAGE => $error);
    $template->param(MYURL => $self->query->url);
    return $template->output;
}

# called if non-existant runmode/page is accessed. Gives a nicer error message, when typing a wrong url
sub AUTOLOAD : Runmode {
    my $self = shift;
    my $rm = shift;
    my $template = $self->load_tmpl("default.html");
    $template->param(NAME => 'AUTOLOAD');
    $template->param(MESSAGE => "<p>Error: could not find run mode \'$rm\'<br>\n");
    $template->param(MYURL => $self->query->url);
    return $template->output;
}

1;

更新 2

我现在发现，当 mustLogin< 时，$self->authen->username 始终设置为 undef /code> runmode 被调用。这意味着多个用户可以登录。

我已经插入了

  open F, ">/tmp/debug";
  print F Dumper $self->authen->username;
  close F;

出现问题的位置。

$self->cfg('SESSIONS_DIR') 返回正确的路径。

知道为什么 $self->authen->username 设置为 undef 并运行 mustLogin 吗？

sub teardown {
  my $self = shift;

  $self->param('found_a_user', 0);

  CGI::Session->find(
      "driver:File;serializer:yaml",
      sub { my_subroutine($self, @_)},
      {Directory => $self->cfg('SESSIONS_DIR'), UMask => 0600,},
      );

  open F, ">/tmp/debug";
  print F Dumper $self->authen->username;
  close F;

  # get state of can_login file
  open my $fh, '+<', 'can_login.yaml';
  flock($fh, LOCK_EX) or die "couldn't get lock: $!\n";
  my $c = YAML::Syck::LoadFile($fh);

  if ( $self->param('found_a_user') ) {
      # found a logged in user with an unexpired session
      $c->{can_login} = 0;
  } else {
      # did NOT find any logged in users
      $c->{can_login} = 1;
  }

  # write
  my $yaml = YAML::Syck::Dump($c);
  $YAML::Syck::ImplicitUnicode = 1;
  seek $fh,0, SEEK_SET;   # seek back to the beginning of file
  print $fh $yaml . "---\n";
  close $fh;
}

sub my_subroutine {
  my $self = shift;
  my ($session) = @_;  # I don't actually need this for anything here

  if ($self->authen->username) {
    $self->param('found_a_user', 1);
  }

}

Answer 1

一次只有一个用户？这是一个相当奇怪的要求。我以前从未做过类似的事情。这是一种解决方法：您需要一个名为“can_login”之类的二进制状态变量。您可以将其存储在文件或数据库中。将其初始化为“true”，然后在用户成功登录后立即将其切换为“false”。如何做到这一点？在 $self->authen->config() 内，定义 POST_LOGIN_CALLBACK 的值。这需要指向代码引用来检查“can_login”值。如果用户已通过身份验证，并且“can_login”为 true，则将“can_login”切换为 false 以阻止其他登录。如果用户已通过身份验证，并且 'can_login' 为 false，则调用 $self->authen->logout 将其注销，并将其重定向到一个显示“只能有一个！”的页面。或其他什么。另外 - 确保在保存登录信息的会话上创建一个超时值，这样您就不会因为有人忘记注销而意外地将所有人锁定。如果将“can_login”值存储在文件中，则必须实施文件锁定以避免竞争条件。如果将其存储在数据库中，则必须弄清楚如何将正确的数据库句柄传递给回调代码引用（可能将其粘贴到 setup() 方法中的全局变量中）。您的注销运行模式应该像往常一样将用户注销，并将“can_login”值切换回 true。处理过期旧会话的代码也应该执行此操作。您甚至可以在单独的进程中执行此操作（例如每 5 分钟运行一次的 cron 作业） - 使旧会话过期，检查活动登录，如果不存在，请确保“can_login”为 true。

更新

关于如何处理过期的会话，让我们假设您的 cgiapp_init() 方法中有类似的内容：

$self->session_config(
  CGI_SESSION_OPTIONS => [
    "driver:File;serializer:yaml",
    $self->query,
    {Directory => $self->cfg('SESSIONS_DIR'), UMask => 0600,},
  ],

  DEFAULT_EXPIRY => '+1h',
  COOKIE_PARAMS => {
    -path     => '/',
    -httponly => 1,        # help avoid XSS attacks
  },
);

那么通常您可能需要这样的拆卸方法：

sub teardown {
  my $self = shift;

  # purge old sessions
  CGI::Session->find(
    "driver:File;serializer:yaml",
    sub {},
    {Directory => $self->cfg('SESSIONS_DIR'), UMask => 0600,},
  );
}

最后调用teardown() 方法每种运行模式。在这种情况下，它所做的只是使旧会话过期（有关更多详细信息，请参阅 CGI::Session 的文档 - 查看“查找”方法下的部分）。一般形式是这样的：

find($dsn, \&code, \%dsn_args);

$dsn 和 \%dsn_args 应与会话配置中的任何内容相匹配 - 这就是我展示我的示例的原因。这里的 coderef 不需要做任何事情，因为 find() 会自动为每个会话调用 load() ，并且这将自动删除任何已经过期的会话 - 因为这就是我想要它做的所有事情，不需要其他任何事情。但您可以使用它来检查登录用户。您必须执行以下操作：

sub teardown {
  my $self = shift;

  $self->param('found_a_user',0);

  CGI::Session->find(
    "driver:File;serializer:yaml",
    sub { my_subroutine( $self, @_ ) },
    {Directory => $self->cfg('SESSIONS_DIR'), UMask => 0600,},
  );

  if ( $self->param('found_a_user') ) {
    # found a logged in user with an unexpired session: set $can_login=0 here
  } else {
    # did NOT find any logged in users - set $can_login=1 here
  }

}

sub my_subroutine {
  my $self = shift;
  my ($session) = @_;  # I don't actually need this for anything here

  if ($self->authen->username) {
    $self->param('found_a_user',1);
  }

}

请注意，my_subroutine 不是方法，因此我必须将 $self 作为额外参数传递。
我需要它来访问authen->用户名，只有当我们有一个具有未过期会话的登录用户时，这才是正确的。请注意，每个会话都会调用此方法，从而删除旧会话。如果“found_a_user”参数设置为 1，那么我们知道我们至少找到了一个活跃用户，并且可以根据需要更新 $can_login 变量。