summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--fml/lib/FML/Command/Admin/off.pm127
-rw-r--r--fml/lib/FML/Command/Admin/on.pm128
-rw-r--r--fml/lib/FML/Command/User/confirm.pm6
-rw-r--r--fml/lib/FML/Command/User/off.pm132
-rw-r--r--fml/lib/FML/Command/User/on.pm135
5 files changed, 526 insertions, 2 deletions
diff --git a/fml/lib/FML/Command/Admin/off.pm b/fml/lib/FML/Command/Admin/off.pm
new file mode 100644
index 00000000..89d0aa20
--- /dev/null
+++ b/fml/lib/FML/Command/Admin/off.pm
@@ -0,0 +1,127 @@
+#-*- perl -*-
+#
+# Copyright (C) 2002 MURASHITA Takuya
+# All rights reserved. This program is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::Admin::off;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+
+=head1 NAME
+
+FML::Command::Admin::off - change off mode specified member
+
+=head1 SYNOPSIS
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+change off mode specified member
+
+=head1 METHODS
+
+=head2 C<process($curproc, $command_args)>
+
+=cut
+
+
+# Descriptions: standard constructor
+# Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+ my ($self) = @_;
+ my ($type) = ref($self) || $self;
+ my $me = {};
+ return bless $me, $type;
+}
+
+
+# Descriptions: need lock or not
+# Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 1;}
+
+
+# Descriptions: change off mode specified member
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $recipient_map
+# Return Value: none
+sub process
+{
+ my ($self, $curproc, $command_args) = @_;
+ my $config = $curproc->{ config };
+ my @recipient_map = split(/\s+/, $config->{ recipient_maps });
+ my $options = $command_args->{ options };
+ my $address = $command_args->{ command_data } || $options->[ 0 ];
+
+ # fundamental check
+ croak("address is not specified") unless defined $address;
+ croak("\@recipient_map is not specified") unless @recipient_map;
+
+ # FML::Command::UserControl specific parameters
+ my $uc_args = {
+ address => $address,
+ maplist => [ @recipient_map ],
+ };
+ my $r = '';
+
+ eval q{
+ use FML::Command::UserControl;
+ my $obj = new FML::Command::UserControl;
+ $obj->userdel($curproc, $command_args, $uc_args);
+ };
+ if ($r = $@) {
+ croak($r);
+ }
+}
+
+
+# Descriptions: show cgi menu for off
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $recipient_map
+# Return Value: none
+sub cgi_menu
+{
+ my ($self, $curproc, $args, $command_args) = @_;
+ my $r = '';
+
+ eval q{
+ use FML::CGI::Admin::User;
+ my $obj = new FML::CGI::Admin::User;
+ $obj->cgi_menu($curproc, $args, $command_args);
+ };
+ if ($r = $@) {
+ croak($r);
+ }
+}
+
+
+=head1 AUTHOR
+
+MURASHITA Takuya
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 MURASHITA Takuya
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::Admin::off appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/FML/Command/Admin/on.pm b/fml/lib/FML/Command/Admin/on.pm
new file mode 100644
index 00000000..c36c9c53
--- /dev/null
+++ b/fml/lib/FML/Command/Admin/on.pm
@@ -0,0 +1,128 @@
+#-*- perl -*-
+#
+# Copyright (C) 2002 MURASHITA Takuya
+# All rights reserved. This program is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::Admin::on;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+
+=head1 NAME
+
+FML::Command::Admin::on - change on mode
+
+=head1 SYNOPSIS
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+change on mode address.
+
+=head1 METHODS
+
+=head2 C<process($curproc, $command_args)>
+
+=cut
+
+
+# Descriptions: standard constructor
+# Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+ my ($self) = @_;
+ my ($type) = ref($self) || $self;
+ my $me = {};
+ return bless $me, $type;
+}
+
+
+# Descriptions: need lock or not
+# Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 1;}
+
+
+# Descriptions: change on mode
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $recipient_map
+# Return Value: none
+sub process
+{
+ my ($self, $curproc, $command_args) = @_;
+ my $config = $curproc->{ config };
+ my $recipient_map = $config->{ primary_recipient_map };
+ my $options = $command_args->{ options };
+ my $address = $command_args->{ command_data } || $options->[ 0 ];
+
+ # fundamental check
+ croak("address is not specified") unless defined $address;
+ croak("\$recipient_map is not specified") unless $recipient_map;
+
+ # FML::Command::UserControl specific parameters
+ my $uc_args = {
+ address => $address,
+ maplist => [ $recipient_map ],
+ };
+ my $r = '';
+
+ eval q{
+ use FML::Command::UserControl;
+ my $obj = new FML::Command::UserControl;
+ $obj->useradd($curproc, $command_args, $uc_args);
+ };
+ if ($r = $@) {
+ croak($r);
+ }
+}
+
+
+# Descriptions: show cgi menu for on
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $recipient_map
+# Return Value: none
+sub cgi_menu
+{
+ my ($self, $curproc, $args, $command_args) = @_;
+ my $r = '';
+
+ eval q{
+ use FML::CGI::Admin::User;
+ my $obj = new FML::CGI::Admin::User;
+ $obj->cgi_menu($curproc, $args, $command_args);
+ };
+ if ($r = $@) {
+ croak($r);
+ }
+}
+
+
+=head1 AUTHOR
+
+MURASHITA Takuya
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 MURASHITA Takuya
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::Admin::on appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Command/User/confirm.pm b/fml/lib/FML/Command/User/confirm.pm
index e32b9aa1..f0eaa0f9 100644
--- a/fml/lib/FML/Command/User/confirm.pm
+++ b/fml/lib/FML/Command/User/confirm.pm
@@ -4,7 +4,7 @@
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#
-# $FML: confirm.pm,v 1.11 2002/07/14 15:15:28 fukachan Exp $
+# $FML: confirm.pm,v 1.12 2002/07/17 09:28:33 fukachan Exp $
#
package FML::Command::User::confirm;
@@ -141,7 +141,9 @@ sub _switch_command
if ($class eq 'subscribe' ||
$class eq 'unsubscribe' ||
- $class eq 'chaddr') {
+ $class eq 'chaddr' ||
+ $class eq 'on' ||
+ $class eq 'off') {
$command_args->{ command_data } = $address;
$command_args->{ command_mode } = 'Admin';
$command_args->{ override_need_no_lock } = 1; # already locked
diff --git a/fml/lib/FML/Command/User/off.pm b/fml/lib/FML/Command/User/off.pm
new file mode 100644
index 00000000..15a4ae7b
--- /dev/null
+++ b/fml/lib/FML/Command/User/off.pm
@@ -0,0 +1,132 @@
+#-*- perl -*-
+#
+# Copyright (C) 2002 MURASHITA Takuya
+# All rights reserved. This program is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::User::off;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use FML::Log qw(Log LogWarn LogError);
+
+
+=head1 NAME
+
+FML::Command::User::off - change off mode
+
+=head1 SYNOPSIS
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+Firstly apply confirmation before off.
+After confirmation succeeds, off process proceeds.
+
+=head1 METHODS
+
+=head2 C<process($curproc, $command_args)>
+
+=cut
+
+
+# Descriptions: standard constructor
+# Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+ my ($self) = @_;
+ my ($type) = ref($self) || $self;
+ my $me = {};
+ return bless $me, $type;
+}
+
+
+# Descriptions: need lock or not
+# Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 1;}
+
+
+# Descriptions: off adapter: confirm before off
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update database for confirmation.
+# prepare reply message.
+# Return Value: none
+sub process
+{
+ my ($self, $curproc, $command_args) = @_;
+ my $config = $curproc->{ config };
+ my $member_map = $config->{ primary_member_map };
+ my $recipient_map = $config->{ primary_recipient_map };
+ my $cache_dir = $config->{ db_dir };
+ my $keyword = $config->{ confirm_command_prefix };
+ my $command = $command_args->{ command };
+ my $address = $curproc->{ credential }->sender();
+
+ # cheap sanity checks
+ croak("\$member_map is not specified") unless $member_map;
+ croak("\$recipient_map is not specified") unless $recipient_map;
+
+ use FML::Credential;
+ my $cred = new FML::Credential;
+
+ # if not member, off request is wrong.
+ unless ($cred->is_member($curproc, { address => $address })) {
+ $curproc->reply_message_nl('error.not_member');
+ LogError("off request from not member");
+ croak("not member");
+ return;
+ }
+
+ # if not recipient, off request is wrong.
+ unless ($cred->is_recipient($curproc, { address => $address })) {
+ $curproc->reply_message_nl('error.not_recipient');
+ LogError("off request from not recipient");
+ croak("not recipient");
+ }
+ # try confirmation before off
+ else {
+ Log("off request, try confirmation");
+
+ use FML::Confirm;
+ my $confirm = new FML::Confirm {
+ keyword => $keyword,
+ cache_dir => $cache_dir,
+ class => 'off',
+ address => $address,
+ buffer => $command,
+ };
+ my $id = $confirm->assign_id;
+ $curproc->reply_message_nl('command.confirm');
+ $curproc->reply_message("\n$id\n");
+ }
+}
+
+
+=head1 AUTHOR
+
+MURASHITA Takuya
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 MURASHITA Takuya
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::User::off appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Command/User/on.pm b/fml/lib/FML/Command/User/on.pm
new file mode 100644
index 00000000..67f53d84
--- /dev/null
+++ b/fml/lib/FML/Command/User/on.pm
@@ -0,0 +1,135 @@
+#-*- perl -*-
+#
+# Copyright (C) 2002 MURASHITA Takuya
+# All rights reserved. This program is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::User::on;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use FML::Log qw(Log LogWarn LogError);
+
+
+=head1 NAME
+
+FML::Command::User::on - on
+
+=head1 SYNOPSIS
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+Firstly apply confirmation before on.
+After confirmation succeeds, on process proceeds.
+
+=head1 METHODS
+
+=head2 C<process($curproc, $command_args)>
+
+=cut
+
+
+# Descriptions: standard constructor
+# Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+ my ($self) = @_;
+ my ($type) = ref($self) || $self;
+ my $me = {};
+ return bless $me, $type;
+}
+
+
+# Descriptions: need lock or not
+# Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 1;}
+
+
+# Descriptions: on adapter.
+# we confirm it before real on process.
+# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update database for confirmation.
+# prepare reply message.
+# Return Value: none
+sub process
+{
+ my ($self, $curproc, $command_args) = @_;
+ my $config = $curproc->{ config };
+ my $member_map = $config->{ primary_member_map };
+ my $recipient_map = $config->{ primary_recipient_map };
+ my $cache_dir = $config->{ db_dir };
+ my $keyword = $config->{ confirm_command_prefix };
+ my $command = $command_args->{ command };
+ my $address = $curproc->{ credential }->sender();
+
+ # fundamental check
+ croak("\$member_map is not specified") unless $member_map;
+ croak("\$recipient_map is not specified") unless $recipient_map;
+
+ use FML::Credential;
+ my $cred = new FML::Credential;
+
+ # if not member, on request is wrong.
+ unless ($cred->is_member($curproc, { address => $address })) {
+ $curproc->reply_message_nl('error.not_member');
+ LogError("on request from not member");
+ croak("not member");
+ return;
+ }
+
+ # if already recipient, on request is wrong.
+ if ($cred->is_recipient($curproc, { address => $address })) {
+ $curproc->reply_message_nl('error.already_recipient',
+ 'already recipient',
+ {
+ _arg_address => $address
+ });
+ croak("already recipient");
+ }
+ # if not, try confirmation before on
+ else {
+ Log("change on mode, try confirmation");
+ use FML::Confirm;
+ my $confirm = new FML::Confirm {
+ keyword => $keyword,
+ cache_dir => $cache_dir,
+ class => 'on',
+ address => $address,
+ buffer => $command,
+ };
+ my $id = $confirm->assign_id;
+ $curproc->reply_message_nl('command.confirm');
+ $curproc->reply_message("\n$id\n");
+ }
+}
+
+
+=head1 AUTHOR
+
+MURASHITA Takuya
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 MURASHITA Takuya
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::User::on appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-01 09:48:31 +0000