chmod results from the CPAN

chmod

CGI-AuthRegister

view release on metacpan or search on metacpan

      "<code>".&htmlquote($redirect_uri)."</code>"; }
    $page =~ s/(<!--37--)>(.*)/$1>$h/;
    $page =~ s/(<!--38--)>(.*)/$1>$t/;
    $page =~ s/<!--!username-->.*?\n\n/\n/s;
    $page =~ s/<!--!password-->.*?\n\n/\n/s;
    if ($redirect_uri ne '') {
      my $stoken = &gen_secret; $userid=~s/["<>]//g;
      my $f = "$DBdir/$DBcasTokens";
      if (!-f $f && !&check_db_files) { $LogReport.=$Error; &store_log;
	print "<html><body>Error: $Error"; exit; }
      if (!-f $f) { putfile $f, ''; chmod 0600, $f; }
      &_db8_append($f, "userid:$userid\nstoken:$stoken" );
      if ($Error ne '') { $LogReport.=$Error; &store_log;
        print "<html><body>Error: $Error"; exit; }
      my $h = "<input type=\"hidden\" name=\"username\" value=\"$userid\">";
      $page=~ s/<!--!hiddenfields-->/$h\n$&/;
      $h = "<input type=\"hidden\" name=\"stoken\" value=\"$stoken\">";
      $page=~ s/<!--!hiddenfields-->/$h\n$&/;
      $page =~ s/(<input class="inputButton" value=)"Login"/$1"Proceed"/;
      my $r = &encodeuri($redirect_uri);
      $page =~ s/(<form id="login_form" action=)"\?login"/$1"$r"/;

AuthRegister.pm view on Meta::CPAN

    "$ENV{SCRIPT_NAME}\">Login page</a>\n";
}

########################################################################
# Section: Session Management

# params: $email, opt: pwstore type: md5 raw
sub reset_password {
    my $email = shift; my $pwstore = shift; $pwstore = 'md5' if $pwstore eq '';
    my $password = &random_password(6); my $pwdf = "$DBdir/$DBpwd";
    if (!-f $pwdf) { putfile $pwdf, ''; chmod 0600, $pwdf }
    if (!&lock_mkdir($pwdf)) { $Error.="378-ERR:\n"; return ''; }
    local *PH; open(PH, $pwdf) or croak($!);
    my $content = '';
    while (<PH>) {
	my ($e,$p) = split;
	$content .= $_ if $e ne $email;
    }
    close(PH);
    $content .= "$email ";
    if   ($pwstore eq 'raw') { $content.="raw:$password" }
    elsif($pwstore eq 'md5') { $content.="md5:".md5_base64($password) }
    else                     { $content.="raw:$password" }
    $content .= "\n";
    putfile $pwdf, $content; chmod 0600, $pwdf; &unlock_mkdir($pwdf);
    return $password;
  }

# $pwstoretype:md5,raw
sub password_set {
  my $email = shift; my $pwd = shift; my $pwstoretype = shift;
  $pwstoretype = 'md5' if $pwstoretype eq '';
  my $pwdf = "$DBdir/$DBpwd";
  if (!&check_db_files) { $Error.="AuthERR-587:\n"; return '' }
  if (!&lock_mkdir($pwdf)) { $Error.="AuthErr-588:\n"; return ''; }

AuthRegister.pm view on Meta::CPAN

  my $newrow = "$email ";
  if ($pwstoretype eq 'md5') { $newrow.="md5:".md5_base64($pwd)."\n" }
  else { $newrow.="raw:$pwd\n" }
  my $content = '';
  while (<PH>) {
    my ($e,$p) = split;
    if ($e eq $email) { $content.=$newrow; $newrow=''; }
    else { $content.=$_ }
  }
  $content.=$newrow; $newrow=''; close(PH);
  putfile $pwdf, $content; chmod 0600, $pwdf; &unlock_mkdir($pwdf);
  return 1;
}

sub md5_base64 {
  my $arg=shift; require Digest::MD5; return Digest::MD5::md5_base64($arg); }

sub random_password {
    my $n = shift; $n = 8 unless $n > 0;
    my @chars = (2..9, 'a'..'k', 'm'..'z', 'A'..'N', 'P'..'Z',
                 qw(, . / ? ; : - = + ! @ $ % *) );

AuthRegister.pm view on Meta::CPAN

    $Error.= "676-ERR: double user key ($k:$v)\n"; return '';
  }
  return $User=$u unless $u eq '';
  $Error.="894-ERR: no user with key ($k:$v)\n"; return '';
}

sub check_db_files {
  my $ret; my $pwfile = "$DBdir/$DBpwd";
  if (!-d $DBdir) { $ret = mkdir($DBdir, 0700);
    if (!$ret) { $Error.="687-ERR: Could not create dir '$DBdir'"; return ''; }}
  if (!-f $pwfile) { putfile $pwfile, ''; chmod 0600, $pwfile; }
  if (!-f $pwfile) { $Error.="689-ERR: Could not create $pwfile file";
		     return ''; }
  my $f = "$DBdir/$DBusers";
  if (!-f $f) { putfile $f, "#userid:someid\n#email:email\@domain.com\n";
		chmod 0600, $f; }
  if (!-f $f) { $Error.="694-ERR: Could not create $f file"; return ''; }
  $f = "$DBdir/$DBsessions";
  if (!-d $f) { $ret = mkdir($f, 0700);
    if (!$ret) { $Error.="708-ERR: Could not create dir '$f'"; return ''; }}

  return 1;
}

# _db8_update - updates given db with minimal changes
# Usage: db8_update($strOrFile, $db)

AuthRegister.pm view on Meta::CPAN

      }
      $r->{$k} = $v;
    }
    if (exists($r->{$kdel}) && $r->{$kdel} eq $vdel) {}
    else { $argcopy .= $record_save }
  }

  if ($argcopy ne $arg_save) {
    if (!open(F, ">$dbf.lock/new")) { &unlock_mkdir($dbf);
      $Error.="828-ERR: opening file $dbf.lock/new: $!"; return ''; }
    print F $argcopy; close(F); chmod 0600, "$dbf.lock/new"; unlink($dbf);
    rename("$dbf.lock/new", $dbf); }
  &unlock_mkdir($dbf);
} # end of _db8_remove

# Read DB records in the RFC822-like style (to add reference).
sub read_db {
  my $arg = shift;
  if ($arg =~ /^file=/) {
    my $f = $'; if (!&lock_mkdir($f)) { return '' }
    local *F;

( run in 0.412 second using v1.01-cache-2.11-cpan-8d75d55dd25 )