Index: user/des/fbce/lib/FBCE/Schema/Result/Person.pm =================================================================== --- user/des/fbce/lib/FBCE/Schema/Result/Person.pm (revision 266498) +++ user/des/fbce/lib/FBCE/Schema/Result/Person.pm (revision 266499) @@ -1,287 +1,292 @@ use utf8; package FBCE::Schema::Result::Person; # Created by DBIx::Class::Schema::Loader # DO NOT MODIFY THE FIRST PART OF THIS FILE =head1 NAME FBCE::Schema::Result::Person =cut use strict; use warnings; use base 'DBIx::Class::Core'; =head1 COMPONENTS LOADED =over 4 =item * L =back =cut __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 TABLE: C =cut __PACKAGE__->table("persons"); =head1 ACCESSORS =head2 id data_type: 'integer' is_auto_increment: 1 is_nullable: 0 sequence: 'persons_id_seq' =head2 login data_type: 'text' is_nullable: 0 original: {data_type => "varchar"} =head2 realname data_type: 'text' is_nullable: 1 original: {data_type => "varchar"} =head2 password data_type: 'text' default_value: '*' is_nullable: 0 original: {data_type => "varchar"} =head2 admin data_type: 'boolean' default_value: false is_nullable: 0 =head2 active data_type: 'boolean' default_value: false is_nullable: 0 =head2 incumbent data_type: 'boolean' default_value: false is_nullable: 0 =head2 voted data_type: 'boolean' default_value: false is_nullable: 0 =head2 votes data_type: 'integer' default_value: 0 is_nullable: 0 =cut __PACKAGE__->add_columns( "id", { data_type => "integer", is_auto_increment => 1, is_nullable => 0, sequence => "persons_id_seq", }, "login", { data_type => "text", is_nullable => 0, original => { data_type => "varchar" }, }, "realname", { data_type => "text", is_nullable => 1, original => { data_type => "varchar" }, }, "password", { data_type => "text", default_value => "*", is_nullable => 0, original => { data_type => "varchar" }, }, "admin", { data_type => "boolean", default_value => \"false", is_nullable => 0 }, "active", { data_type => "boolean", default_value => \"false", is_nullable => 0 }, "incumbent", { data_type => "boolean", default_value => \"false", is_nullable => 0 }, "voted", { data_type => "boolean", default_value => \"false", is_nullable => 0 }, "votes", { data_type => "integer", default_value => 0, is_nullable => 0 }, ); =head1 PRIMARY KEY =over 4 =item * L =back =cut __PACKAGE__->set_primary_key("id"); =head1 UNIQUE CONSTRAINTS =head2 C =over 4 =item * L =back =cut __PACKAGE__->add_unique_constraint("persons_login_key", ["login"]); =head1 RELATIONS =head2 statement Type: might_have Related object: L =cut __PACKAGE__->might_have( "statement", "FBCE::Schema::Result::Statement", { "foreign.person" => "self.id" }, { cascade_copy => 0, cascade_delete => 0 }, ); =head2 votes_candidates Type: has_many Related object: L =cut __PACKAGE__->has_many( "votes_candidates", "FBCE::Schema::Result::Vote", { "foreign.candidate" => "self.id" }, { cascade_copy => 0, cascade_delete => 0 }, ); =head2 votes_voters Type: has_many Related object: L =cut __PACKAGE__->has_many( "votes_voters", "FBCE::Schema::Result::Vote", { "foreign.voter" => "self.id" }, { cascade_copy => 0, cascade_delete => 0 }, ); # Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-03-10 19:05:50 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:40qaS/evx1U+HUHTXygyFQ use Crypt::SaltedHash; -use Digest::MD5 qw(md5_hex); # # Change the password. # sub set_password($$) { my ($self, $password) = @_; - my $csh = new Crypt::SaltedHash(algorithm => 'SHA-1'); + if ($password !~ m/^[[:print:]]{8,}$/a || $password !~ m/[0-9]/a || + $password !~ m/[A-Z]/a || $password !~ m/[a-z]/a) { + die("Your password must be at least 8 characters long and contain" . + " at least one upper-case letter, one lower-case letter and" . + " one digit.\n"); + } + my $csh = new Crypt::SaltedHash(algorithm => 'SHA-256'); $csh->add($password); $self->set_column(password => $csh->generate()); $self->update() if $self->in_storage(); } # # Check the password. # sub check_password($$) { my ($self, $password) = @_; return Crypt::SaltedHash->validate($self->password, $password); } # # Pretty name # sub name($) { my ($self) = @_; return $self->realname || ($self->login . '@freebsd.org'); } # # Commit votes # sub commit($) { my ($self) = @_; my $schema = $self->result_source->schema; $schema->txn_do(sub { my $votes = $self->votes_voters; while (my $vote = $votes->next) { $vote->candidate->votes++; $vote->delete; } }); } # # Email address # sub email($) { my ($self) = @_; return $self->login . "\@freebsd.org"; } # # Gravatar URL # sub gravatar($;$) { my ($self, $scheme) = @_; my $md5 = md5_hex($self->email); if ($scheme eq 'https') { return "https://secure.gravatar.com/avatar/$md5"; } else { return "http://www.gravatar.com/avatar/$md5"; } } 1; # $FreeBSD$ Index: user/des/fbce/lib/FBCE/Script/User.pm =================================================================== --- user/des/fbce/lib/FBCE/Script/User.pm (revision 266498) +++ user/des/fbce/lib/FBCE/Script/User.pm (revision 266499) @@ -1,362 +1,374 @@ +use utf8; package FBCE::Script::User; use Moose; -use MooseX::Types::Common::Numeric qw/PositiveInt/; -use MooseX::Types::Moose qw/Str Bool Int/; +use MooseX::Types::Moose qw/Bool Str/; use FBCE; use Archive::Tar; -use LWP::UserAgent; use namespace::autoclean; -use Data::Dumper; - with 'Catalyst::ScriptRole'; has debug => ( traits => [qw(Getopt)], cmd_aliases => 'd', isa => Bool, is => 'ro', documentation => q{Debugging mode}, ); has dryrun => ( traits => [qw(Getopt)], cmd_aliases => 'n', isa => Bool, is => 'ro', documentation => q{Dry run}, ); -# XXX should be traits -our %lwp_options = ( - timeout => 10, - env_proxy => 1, - keep_alive => 1, +has tarball => ( + traits => [qw(Getopt)], + cmd_aliases => 't', + isa => Str, + is => 'ro', + documentation => q{Name of password tarball}, + default => 'fbce-passwords.tgz', ); -# Survey URLs for various repos -sub survey_url($) { "http://people.freebsd.org/~peter/$_[0].total.txt" } +has file => ( + traits => [qw(Getopt)], + cmd_aliases => 'f', + isa => Str, + is => 'ro', + documentation => q{Name of password file}, + default => 'fbce-password', +); -# Name of password tarball -our $pwtar = 'fbce-passwords.tgz'; - # -# Download and parse Peter Wemm's survey for a specific repo +# Read a list of users. # -sub retrieve_commit_data($$) { - my ($self, $repo) = @_; +sub _read_users($@) { + my ($self, @argv) = @_; - # create new user agent unless one already exists - $self->{user_agent} //= LWP::UserAgent->new(%lwp_options); - my $url = survey_url($repo); - my $req = HTTP::Request->new(GET => $url); - warn("Retrieving $url...\n") - if $self->debug; - my $res = $self->{user_agent}->request($req); - if (!$res->is_success()) { - die("$url: " . $res->status_line() . "\n"); - } - my $survey = $res->decoded_content(); - foreach (split('\n', $survey)) { - # - # Each line looks like this: - # - # 20120430 ok 84 95 des - # - # The first column is the date of the last commit. The second - # column is "ok" if this committer has a commit bit in this - # repo, "doc" or "visitor" if they have a commit bit in a - # different repo or "-" if they are retired. The third and - # fourth columns are not relevant to us. The fifth is the - # freefall login. - # - next unless m/^(\d\d\d\d)(\d\d)(\d\d)\s+ - (?:\w+)\s+ - (?:\d+)\s+ - (?:\d+)\s+ - (\w+)\s*$/x && - $1 > 0 && $2 > 0 && $3 > 0; - my $date = DateTime->new(year => $1, month => $2, day => $3, - time_zone => 'UTC'); - my $login = $4; - if (defined($self->{committers}->{$login}) && - DateTime->compare($date, $self->{committers}->{$login}) < 0) { -# warn(sprintf("skipping %s: %s < %s\n", $login, $date->ymd(), -# $self->{committers}->{$login}->ymd())) -# if $self->debug; + my %users; + @ARGV = @argv; + while (<>) { + chomp(); + if (m/^\s*(\w+)\s*$/) { + # login + $users{$1} = $1; + } elsif (m/^\s*(\w+)\s+(\S.*\S)\s*$/) { + # login gecos + $users{$1} = $2; + } elsif (m/^(\w+)(?::[^:]*){3}:([^:,]*)(?:,[^:]*)?(?::[^:]*){2}$/) { + # v7 passwd file + $users{$1} = $2 || $1; + } elsif (m/^(\w+)(?::[^:]*){6}:([^:,]*)(?:,[^:]*)?(?::[^:]*){2}$/) { + # BSD passwd file + $users{$1} = $2 || $1; } else { -# warn(sprintf("adding %s: %s (%s)\n", $login, $date->ymd(), $repo)) -# if $self->debug; - $self->{committers}->{$login} = $date; + # ignore } } + return \%users; } # +# Activate or deactivate named users +# +sub _set_active($$@) { + my ($self, $active, @users) = @_; + + my $persons = FBCE->model('FBCE::Person'); + my $schema = $persons->result_source()->schema(); + $schema->txn_do(sub { + foreach my $login (@users) { + my $person = $persons->find({ login => $login }); + if ($person) { + warn("marking $login " . + ($active ? "active" : "inactive") . "\n") + if $self->debug; + $person->update({ active => $active }); + } else { + warn("No such user: $login\n"); + } + } + $schema->txn_rollback() + if $self->dryrun; + }); +} + +# +# Mark named users as incumbent or not +# +sub _set_incumbent($$@) { + my ($self, $incumbent, @users) = @_; + + my $persons = FBCE->model('FBCE::Person'); + my $schema = $persons->result_source()->schema(); + $schema->txn_do(sub { + foreach my $login (@users) { + my $person = $persons->find({ login => $login }); + if ($person) { + warn("marking $login " . + ($incumbent ? "incumbent" : "inincumbent") . "\n") + if $self->debug; + $person->update({ incumbent => $incumbent }); + } else { + warn("No such user: $login\n"); + } + } + $schema->txn_rollback() + if $self->dryrun; + }); +} + +# # List existing users # -sub cmd_list(@) { +sub cmd_list($@) { my ($self, @argv) = @_; die("too many arguments") if @argv; my $persons = FBCE->model('FBCE::Person')-> - search({}, { order_by => 'login' }); + search(undef, { order_by => 'login' }); printf("%-16s%-8s%-8s%s\n", 'login', 'active', 'admin', 'name'); foreach my $person ($persons->all()) { printf("%-16s%-8s%-8s%s\n", $person->login, $person->active ? 'yes' : 'no', $person->admin ? 'yes' : 'no', $person->name); } } # # Mark all users inactive # -sub cmd_smash(@) { +sub cmd_smash($@) { my ($self, @argv) = @_; die("too many arguments") if @argv; - my $persons = FBCE->model('FBCE::Person')->search(); + my $persons = FBCE->model('FBCE::Person'); my $schema = $persons->result_source()->schema(); $schema->txn_do(sub { - $persons->reset(); - while (my $person = $persons->next) { - $person->update({ active => 0 }); + foreach my $person ($persons->all) { + $person->update({ active => 0, incumbent => 0 }); } $schema->txn_rollback() if $self->dryrun; }); } # -# Pull the list of active committers; create users for committers that -# don't already have one, and set the active bit. +# Activate named users # -sub cmd_pull(@) { +sub cmd_activate(@) { my ($self, @argv) = @_; - die("too many arguments") - if @argv; + my $users = $self->_read_users(@argv); + $self->_set_active(1, keys %$users); +} - # retrieve cutoff date - my $cutoff_date = FBCE->model('Rules')->cutoff_date; - warn(sprintf("Setting cutoff date to %sT%sZ\n", - $cutoff_date->ymd(), $cutoff_date->hms())) - if $self->debug; +# +# Deactivate named users +# +sub cmd_deactivate(@) { + my ($self, @argv) = @_; - # pull "last commit" data for src, ports and doc / www repos - foreach my $repo (qw(src ports docwww)) { - $self->retrieve_commit_data($repo); - } + my $users = $self->_read_users(@argv); + $self->_set_active(0, keys %$users); +} - # insert it into the database +# +# Mark the specified user(s) as incumbent +# +sub cmd_incumbent(@) { + my ($self, @argv) = @_; + + my $users = $self->_read_users(@argv); + $self->_set_incumbent(1, keys %$users); +} + +# +# Read a list of users from a file and create corresponding database +# records. This will not touch existing users. +# +sub cmd_import(@) { + my ($self, @argv) = @_; + + my $users = $self->_read_users(@argv); my $persons = FBCE->model('FBCE::Person'); my $schema = $persons->result_source()->schema(); $schema->txn_do(sub { - while (my ($login, $last_commit) = each(%{$self->{committers}})) { + while (my ($login, $gecos) = each(%$users)) { my $person = $persons->find_or_new({ login => $login }); - my $active = - DateTime->compare($last_commit, $cutoff_date) >= 0 ? 1 : 0; - if ($person->in_storage()) { - if ($active != $person->active) { - warn(sprintf("updating %s: %s -> %s\n", - $person->login, - $person->active ? 'active' : 'inactive', - $active ? 'active' : 'inactive')) - if $self->debug; - $person->update({ active => $active }); - } - } else { - $person->set_column(active => $active); - $person->insert(); - } + next if $person->in_storage; + warn("importing user $login\n") + if $self->debug; + $person->set_columns({ realname => $gecos }); + $person->update_or_insert(); } $schema->txn_rollback() if $self->dryrun; }); } # -# Set each user's realname column based on their gecos +# Read a list of users from a file and set their names accordingly. +# Users that are listed in the file but not in the database will be +# ignored. # -sub cmd_gecos(@) { - my ($self, $pwfn, @argv) = @_; +sub cmd_gecos($@) { + my ($self, @argv) = @_; - my %gecos; - - die("too many arguments") - if @argv; - - # read passwd file - $pwfn //= "/etc/passwd"; - open(my $pwfh, '<', $pwfn) - or die("$pwfn: $!\n"); - warn("reading names from $pwfn\n") - if $self->debug; - while (<$pwfh>) { - chomp($_); - my @pwent = split(':', $_); - next unless @pwent == 7; - next unless $pwent[4] =~ m/^([^,]+)/; - $gecos{$pwent[0]} = $1; - } - close($pwfh); - - # update the database - my $persons = FBCE->model('FBCE::Person')-> - search({}, { order_by => 'login' }); + my $users = $self->_read_users(@argv); + my $persons = FBCE->model('FBCE::Person'); my $schema = $persons->result_source()->schema(); - my $n; $schema->txn_do(sub { - warn("setting names in the database\n") - if $self->debug; - $n = 0; - $persons->reset(); - while (my $person = $persons->next) { - my $login = $person->login; - my $gecos = $gecos{$login}; - next unless $gecos; - next if $person->realname; + while (my ($login, $gecos) = each(%$users)) { + my $person = $persons->find({ login => $login }) + or next; $person->update({ realname => $gecos }); - ++$n; } - warn("$n record(s) updated\n") - if $self->debug; $schema->txn_rollback() if $self->dryrun; }); } # -# Use sysutils/pwgen2 to generate random passwords +# Use sysutils/pwgen to generate random passwords # sub pwgen($$;$) { my ($self, $n, $len) = @_; $len ||= 12; warn("generating $n $len-character passwords\n") if $self->debug; # Set up a pipe and fork a child my $pid = open(my $pipe, '-|'); if (!defined($pid)) { # fork failed die("fork(): $!\n"); } elsif ($pid == 0) { # child process - run pwgen # ugh hardcoded... - exec('/usr/local/bin/pwgen', '-can', $len, $n); - die("child: exec(): $!\n"); + exec('/usr/local/bin/pwgen', '-can', $len, $n); + die("child: exec(): $!\n"); } # read output from child my @passwords; while (<$pipe>) { m/^([0-9A-Za-z]{$len})$/ or die("invalid output from pwgen\n"); push(@passwords, $1); } # check exit status if (waitpid($pid, 0) != $pid) { - if ($? & 0xff) { - die(sprintf("pwgen caught signal %d\n", $? & 0x7f)); - } elsif ($? >> 8) { - die(sprintf("pwgen exited with code %d\n", $? >> 8)); - } else { - die("waitpid(): $!\n"); - } + if ($? & 0xff) { + die(sprintf("pwgen caught signal %d\n", $? & 0x7f)); + } elsif ($? >> 8) { + die(sprintf("pwgen exited with code %d\n", $? >> 8)); + } else { + die("waitpid(): $!\n"); + } } close($pipe); # sanity check and we're done - die(sprintf("expected %d passwords, got %d\n", $n, @passwords)) + die(sprintf("expected %d passwords, got %d\n", $n, int(@passwords))) unless @passwords == $n; warn("got $n passwords as expected\n") if $self->debug; return @passwords; } # -# Generate passwords for all users. Use with caution! +# Generate passwords users that don't already have one. Use with +# caution! # -sub cmd_pwgen(@) { +sub cmd_pwgen($@) { my ($self, @argv) = @_; die("too many arguments") if @argv; - # please don't overwrite an existing password tarball... - die("$pwtar exists, delete or move and try again\n") - if -e $pwtar; + # Please don't overwrite an existing password tarball! + my $tarball = $self->tarball; + die("$tarball exists, delete or move and try again\n") + if -e $tarball; + my $pwfile = $self->file; - # generate enough passwords for everybody + # Generate enough passwords for everybody my $persons = FBCE->model('FBCE::Person')-> search({ password => '*' }, { order_by => 'login' }); my $n = $persons->count(); my @passwords = $self->pwgen($n); # create the archive my $tar = Archive::Tar->new(); # update the database and the archive my $schema = $persons->result_source()->schema(); $schema->txn_do(sub { warn("setting the passwords in the database\n") if $self->debug; - $persons->reset(); - while (my $person = $persons->next) { + foreach my $person ($persons->all) { my ($login, $password) = ($person->login, shift(@passwords)); - # printf("%s\t%s\n", $person->login, $password); warn("setting password for $login\n") if $self->debug; $person->set_password($password); - $tar->add_data("$login/election-password", "$password\n", + $tar->add_data("$login/$pwfile", "$password\n", { uname => $login, gname => $login, mode => 0400 }); } warn("writing the tar file\n") if $self->debug; - $tar->write($pwtar, COMPRESS_GZIP) + $tar->write($tarball, COMPRESS_GZIP) or die($tar->error()); $schema->txn_rollback() if $self->dryrun; }); } sub run($) { my ($self) = @_; local $ENV{CATALYST_DEBUG} = 1 - if $self->debug; + if $self->debug; my $command = shift(@{$self->extra_argv}) or die("command required\n"); if ($command eq 'list') { $self->cmd_list(@{$self->extra_argv}); + } elsif ($command eq 'import') { + $self->cmd_import(@{$self->extra_argv}); } elsif ($command eq 'smash') { $self->cmd_smash(@{$self->extra_argv}); - } elsif ($command eq 'pull') { - $self->cmd_pull(@{$self->extra_argv}); + } elsif ($command eq 'activate') { + $self->cmd_activate(@{$self->extra_argv}); + } elsif ($command eq 'deactivate') { + $self->cmd_deactivate(@{$self->extra_argv}); + } elsif ($command eq 'incumbent') { + $self->cmd_incumbent(@{$self->extra_argv}); } elsif ($command eq 'gecos') { $self->cmd_gecos(@{$self->extra_argv}); } elsif ($command eq 'pwgen') { $self->cmd_pwgen(@{$self->extra_argv}); } else { die("unrecognized command.\n"); } } __PACKAGE__->meta->make_immutable; 1; # $FreeBSD$