view release on metacpan or  search on metacpan

lib/Mozilla/Persona/Setup.pm  view on Meta::CPAN

        { class  => 'Mozilla::Persona::Validate::Table'
        , pwfile => "$secrets/passwords"
        , domain => $domain
        }
     );

    $persona->writeConfig($config);

    publish_helpers $setup_src, "$docroot/persona", $config;

    print __x"now you probably want to modify {fn}", fn => $config;
}

#### HELPERS

sub get_jquery($$)
{   my ($from_url, $to_fn) = @_;

    if(-f $to_fn && !$restart)
    {   info __x"reusing jquery from {fn}", fn => $to_fn;
        return;
    }

    info __x"downloading latest jquery stable into {fn}", fn => $to_fn;

    $ua ||= LWP::UserAgent->new;
    my $resp = $ua->get($from_url);
    $resp->is_success
        or error __x"failed downloading jquery from {url}: {err}"
             , url => $from_url. err => $resp->status_line;

    write_file $to_fn, $resp->decoded_content || $resp->content;
}

sub create_private_key($$)
{   my ($outfn, $group) = @_;

    my $gid = getpwnam $group
        or error __x"unknown group {name}", name => $group;

    if(-f $outfn && !$restart)
    {   info __x"reusing private key in {fn}", fn => $outfn;

        my $has_gid = (stat $outfn)[5];
        $gid == $has_gid
            or warning __x"please set group on {fn} to {group}"
                 , fn => $outfn, group => $group;

        return;
    }

    info __x"generating new private key at {fn}", fn => $outfn;

    ! -f $outfn || unlink $outfn
        or fault __x"cannot replace existing pem file in {fn}", fn => $outfn;

    my $key = Crypt::OpenSSL::RSA->generate_key(2048);
    write_file $outfn, $key->get_private_key_string;

    chmod 0440, $outfn;
    chown -1, $gid, $outfn
        or warning __x"please set group on {fn} to {group}"
             , fn => $outfn, group => $group;

    $key;
}

sub publish_config($$)
{   my ($outfn, $keyfn) = @_;

    my $pem = read_file $keyfn;
    my $key = Crypt::OpenSSL::RSA->new_private_key($pem);

    my ($n, $e, @stuff) = $key->get_key_parameters;
    write_file $outfn, encode_json
      { 'public-key'     =>
          { e => $e->to_decimal
          , n => $n->to_decimal
          , algorithm => 'RS'
          }
      , authentication => '/persona/authenticate.html'
      , provisioning   => '/persona/provision.html'
      };

    info __x"public configuration written to {fn}", fn => $outfn;
    $outfn;
}

sub publish_helpers($$$)
{   my ($indir, $outdir, $config) = @_;
    local(*FROM, *TO);
    -d $outdir or mkdir $outdir
        or fault __x"cannot create directory {dir}", dir => $outdir;

    foreach my $fn (glob "$indir/*")
    {   my $outfn = $outdir.'/'.basename $fn;
        if(-f $outfn && !$restart)
        {   info __x"keeping file {fn}", fn => $outfn;
            next;
        }

        open FROM, '<:encoding(utf8)', $fn
            or fault __x"cannot read {filename}", filename => $fn;

        open TO, '>:encoding(utf8)', $outfn
            or fault __x"cannot write to {filename}", filename => $outfn;

        while(<FROM>)
        {   s/__CONFIG__/$config/;
            print TO $_;
        }

        close TO;
        close FROM;

        my $mode = $outfn =~ m/\.pl$/i ? 0755 : 0644;
        chmod $mode, $outfn;

        info __x"created file {fn} more 0{mode%o}", fn => $outfn, mode => $mode;
    }
}