Conf.pm 13.3 KB
Newer Older
1
# This module implements all the methods that responds to '/confs/*' requests
2
# It contains 2 sections:
3 4
#  - initialization methods
#  - upload method
5 6
#
# Read methods are inherited from Lemonldap::NG::Common::Conf::RESTServer
7 8 9
package Lemonldap::NG::Manager::Conf;

use 5.10.0;
Yadd's avatar
Yadd committed
10
use utf8;
11 12
use Mouse;
use Lemonldap::NG::Common::Conf::Constants;
Yadd's avatar
Yadd committed
13
use Lemonldap::NG::Common::UserAgent;
14 15
use Crypt::OpenSSL::RSA;
use Convert::PEM;
16
use URI::URL;
17 18 19

use feature 'state';

20
extends 'Lemonldap::NG::Common::Conf::RESTServer';
21

Yadd's avatar
Yadd committed
22
our $VERSION = '2.0.2';
23

24 25 26 27 28 29
#############################
# I. INITIALIZATION METHODS #
#############################

use constant defaultRoute => 'manager.html';

Yadd's avatar
Yadd committed
30 31
has ua => ( is => 'rw' );

32
sub addRoutes {
Yadd's avatar
Yadd committed
33
    my ( $self, $conf ) = @_;
Yadd's avatar
Tidy  
Yadd committed
34
    $self->ua( Lemonldap::NG::Common::UserAgent->new($conf) );
35 36 37 38

    # HTML template
    $self->addRoute( 'manager.html', undef, ['GET'] )

39 40 41
        # READ
        # Special keys
        ->addRoute(
42 43
        confs => {
            ':cfgNum' => [
Yadd's avatar
Yadd committed
44
                qw(virtualHosts samlIDPMetaDataNodes samlSPMetaDataNodes
45 46 47 48
                    applicationList oidcOPMetaDataNodes oidcRPMetaDataNodes
                    casSrvMetaDataNodes casAppMetaDataNodes
                    authChoiceModules grantSessionRules combModules
                    openIdIDPList)
49 50 51
            ]
        },
        ['GET']
52
        )
53

54 55
        # Other keys
        ->addRoute( confs => { ':cfgNum' => { '*' => 'getKey' } }, ['GET'] )
56

57 58 59 60 61 62 63
        # New key and conf save
        ->addRoute(
        confs => {
            newRSAKey => 'newRSAKey',
            raw       => 'newRawConf',
            '*'       => 'newConf'
        },
64
        ['POST']
65
        )
Yadd's avatar
Yadd committed
66

67 68 69
        # Difference between confs
        ->addRoute( diff => { ':conf1' => { ':conf2' => 'diff' } } )
        ->addRoute( 'diff.html', undef, ['GET'] )
70

71 72
        # Url loader
        ->addRoute( 'prx', undef, ['POST'] );
73 74
}

Yadd's avatar
Yadd committed
75 76 77
# 35 - New RSA key pair on demand
#      --------------------------

Yadd's avatar
Yadd committed
78
##@method public PSGI-JSON-response newRSAKey($req)
Yadd's avatar
Yadd committed
79
# Return a hashref containing private and public keys
Yadd's avatar
Yadd committed
80
# The posted data must contain a JSON object containing
Yadd's avatar
Yadd committed
81 82
# {"password":"newpassword"}
#
Yadd's avatar
Yadd committed
83 84
#@param $req Lemonldap::NG::Common::PSGI::Request object
#@return PSGI JSON response
Yadd's avatar
Yadd committed
85 86 87
sub newRSAKey {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newRSAKey"', 400 )
88
        if (@others);
Yadd's avatar
Yadd committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
    my $query = $req->jsonBodyToObj;
    my $rsa   = Crypt::OpenSSL::RSA->generate_key(2048);
    my $keys  = {
        'private' => $rsa->get_private_key_string(),
        'public'  => $rsa->get_public_key_x509_string(),
    };
    if ( $query->{password} ) {
        my $pem = Convert::PEM->new(
            Name => 'RSA PRIVATE KEY',
            ASN  => q(
                RSAPrivateKey SEQUENCE {
                    version INTEGER,
                    n INTEGER,
                    e INTEGER,
                    d INTEGER,
                    p INTEGER,
                    q INTEGER,
                    dp INTEGER,
                    dq INTEGER,
                    iqmp INTEGER
    }
               )
        );
        $keys->{private} = $pem->encode(
            Content  => $pem->decode( Content => $keys->{private} ),
            Password => $query->{password},
        );
    }
    return $self->sendJSONresponse( $req, $keys );
}

Yadd's avatar
Yadd committed
120 121 122 123 124 125 126 127 128 129
# 36 - URL File loader
#      ---------------

##@method public PSGI-JSON-response prx()
# Load file using posted URL and return its content
#
#@return PSGI JSON response
sub prx {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "prx"', 400 )
130
        if (@others);
Yadd's avatar
Yadd committed
131 132
    my $query = $req->jsonBodyToObj;
    return $self->sendError( $req, 'Missing parameter', 400 )
133
        unless ( $query->{url} );
Yadd's avatar
Yadd committed
134
    return $self->sendError( $req, 'Bad parameter', 400 )
135
        unless ( $query->{url} =~ m#^(?:f|ht)tps?://\w# );
Yadd's avatar
Yadd committed
136
    $self->ua->timeout(10);
Yadd's avatar
Yadd committed
137

Yadd's avatar
Yadd committed
138
    my $response = $self->ua->get( $query->{url} );
Yadd's avatar
Yadd committed
139 140 141 142
    unless ( $response->code == 200 ) {
        return $self->sendError( $req,
            $response->code . " (" . $response->message . ")", 400 );
    }
143 144
    unless ( $response->header('Content-Type')
        =~ m#^(?:application/json|(?:application|text)/.*xml).*$# )
Yadd's avatar
Yadd committed
145 146
    {
        return $self->sendError( $req,
147 148
            'Content refused for security reason (neither XML or JSON)',
            400 );
Yadd's avatar
Yadd committed
149 150 151 152
    }
    return $self->sendJSONresponse( $req, { content => $response->content } );
}

153 154 155 156
######################
# IV. Upload methods #
######################

Yadd's avatar
Yadd committed
157 158
# In this section, 4 methods:
#  - getConfByNum: override SUPER method to be able to use Zero
Yadd's avatar
Yadd committed
159 160 161 162 163
#  - newConf()
#  - newRawConf(): restore a saved conf
#  - applyConf(): called by the 2 previous to prevent other servers that a new
#                 configuration is available

Yadd's avatar
Yadd committed
164 165 166 167 168 169 170 171 172 173 174 175 176
sub getConfByNum {
    my ( $self, $cfgNum, @args ) = @_;
    unless ( %{ $self->currentConf }
        and $cfgNum == $self->currentConf->{cfgNum} )
    {
        my $tmp;
        if ( $cfgNum == 0 ) {
            require Lemonldap::NG::Manager::Conf::Zero;
            $tmp = Lemonldap::NG::Manager::Conf::Zero::zeroConf();
            $self->currentConf($tmp);
        }
        else {
            $tmp = $self->SUPER::getConfByNum( $cfgNum, @args );
Yadd's avatar
Yadd committed
177
            return undef unless ( defined $tmp );
Yadd's avatar
Yadd committed
178 179 180 181 182
        }
    }
    return $cfgNum;
}

183
## @method PSGI-JSON-response newConf($req)
184
# Call Lemonldap::NG::Manager::Conf::Parser to parse new configuration and store
185 186
# it
#
Yadd's avatar
Yadd committed
187
#@param $req Lemonldap::NG::Common::PSGI::Request
188 189
#@return PSGI JSON response
sub newConf {
190
    my ( $self, $req, @other ) = @_;
191
    return $self->sendError( $req, 'There is no subkey for "newConf"', 400 )
192
        if (@other);
193 194 195 196 197 198 199 200

    # Body must be json
    my $new = $req->jsonBodyToObj;
    unless ( defined($new) ) {
        return $self->sendError( $req, undef, 400 );
    }

    # Verify that cfgNum has been asked
Yadd's avatar
Yadd committed
201
    unless ( defined $req->params('cfgNum') ) {
202 203 204 205
        return $self->sendError( $req, "Missing configuration number", 400 );
    }

    # Set current conf to cfgNum
206
    unless ( defined $self->getConfByNum( $req->params('cfgNum') ) ) {
207 208
        return $self->sendError(
            $req,
209
            "Configuration "
210 211 212
                . $req->params('cfgNum')
                . " not available "
                . $Lemonldap::NG::Common::Conf::msg,
213 214 215 216 217
            400
        );
    }

    # Parse new conf
218 219
    require Lemonldap::NG::Manager::Conf::Parser;
    my $parser = Lemonldap::NG::Manager::Conf::Parser->new(
220
        { tree => $new, refConf => $self->currentConf, req => $req } );
221 222 223

    # If ref conf isn't last conf, consider conf changed
    my $cfgNum = $self->confAcc->lastCfg;
Yadd's avatar
Yadd committed
224
    unless ( defined $cfgNum ) {
225 226
        $req->error($Lemonldap::NG::Common::Conf::msg);
    }
Yadd's avatar
Yadd committed
227 228
    return $self->sendError( $req, undef, 400 ) if ( $req->error );

229 230
    if ( $cfgNum ne $req->params('cfgNum') ) { $parser->confChanged(1); }

231 232
    my $res = { result => $parser->check };

Yadd's avatar
Yadd committed
233 234
    # "message" fields: note that words enclosed by "__" (__word__) will be
    # translated
235 236 237 238 239 240 241 242 243 244 245
    $res->{details}->{'__errors__'} = $parser->{errors}
        if ( @{ $parser->{errors} } );
    unless ( @{ $parser->{errors} } ) {
        $res->{details}->{'__needConfirmation__'}
            = $parser->{needConfirmation}
            if ( @{ $parser->{needConfirmation} } && !$req->params('force') );
        $res->{message} = $parser->{message};
        foreach my $t (qw(warnings changes)) {
            $res->{details}->{ '__' . $t . '__' } = $parser->$t
                if ( @{ $parser->$t } );
        }
246 247 248 249 250 251 252 253
    }
    if ( $res->{result} ) {
        if ( $self->{demoMode} ) {
            $res->{message} = '__demoModeOn__';
        }
        else {
            my %args;
            $args{force} = 1 if ( $req->params('force') );
254 255 256
            my $s = CONFIG_WAS_CHANGED;
            $s = $self->confAcc->saveConf( $parser->newConf, %args )
                unless ( @{ $parser->{needConfirmation} } && !$args{force} );
257
            if ( $s > 0 ) {
258
                $self->userLogger->notice(
Yadd's avatar
Yadd committed
259
                    'User ' . $self->userId($req) . " has stored conf $s" );
260 261
                $res->{result} = 1;
                $res->{cfgNum} = $s;
Yadd's avatar
Yadd committed
262
                if ( my $status = $self->applyConf( $parser->newConf ) ) {
Yadd's avatar
Yadd committed
263
                    push @{ $res->{details}->{__applyResult__} },
264 265
                        { message => "$_: $status->{$_}" }
                        foreach ( keys %$status );
Yadd's avatar
Yadd committed
266
                }
267 268
            }
            else {
269
                $self->userLogger->notice(
Yadd's avatar
Yadd committed
270
                    'Saving attempt rejected, asking for confirmation to '
271
                        . $self->userId($req) );
272
                $res->{result} = 0;
Yadd's avatar
Yadd committed
273 274
                if ( $s == CONFIG_WAS_CHANGED ) {
                    $res->{needConfirm} = 1;
275 276
                    $res->{message} .= '__needConfirmation__'
                        unless @{ $parser->{needConfirmation} };
Yadd's avatar
Yadd committed
277
                }
Yadd's avatar
Yadd committed
278 279 280
                else {
                    $res->{message} = $Lemonldap::NG::Common::Conf::msg;
                }
281 282 283 284 285 286
            }
        }
    }
    return $self->sendJSONresponse( $req, $res );
}

Yadd's avatar
Yadd committed
287 288 289
## @method PSGI-JSON-response newRawConf($req)
# Store directly raw configuration
#
Yadd's avatar
Yadd committed
290
#@param $req Lemonldap::NG::Common::PSGI::Request
Yadd's avatar
Yadd committed
291
#@return PSGI JSON response
292
sub newRawConf {
293
    my ( $self, $req, @other ) = @_;
294
    return $self->sendError( $req, 'There is no subkey for "newConf"', 400 )
295
        if (@other);
296 297 298 299 300 301 302 303 304 305 306 307

    # Body must be json
    my $new = $req->jsonBodyToObj;
    unless ( defined($new) ) {
        return $self->sendError( $req, undef, 400 );
    }

    my $res = {};
    if ( $self->{demoMode} ) {
        $res->{message} = '__demoModeOn__';
    }
    else {
308 309 310
        # When uploading a new conf, always force it since cfgNum has a few
        # chances to be equal to last config cfgNum
        my $s = $self->confAcc->saveConf( $new, force => 1 );
311
        if ( $s > 0 ) {
312
            $self->userLogger->notice(
Yadd's avatar
Yadd committed
313
                'User ' . $self->userId($req) . " has stored (raw) conf $s" );
314 315 316 317
            $res->{result} = 1;
            $res->{cfgNum} = $s;
        }
        else {
318
            $self->userLogger->notice(
Yadd's avatar
Yadd committed
319
                'Raw saving attempt rejected, asking for confirmation to '
320
                    . $self->userId($req) );
321 322 323 324 325 326 327 328
            $res->{result} = 0;
            $res->{needConfirm} = 1 if ( $s == CONFIG_WAS_CHANGED );
            $res->{message} .= '__needConfirmation__';
        }
    }
    return $self->sendJSONresponse( $req, $res );
}

Yadd's avatar
Yadd committed
329
## @method private applyConf()
Yadd's avatar
Yadd committed
330 331 332 333
# Try to prevent other servers declared in `reloadUrls` that a new
# configuration is available.
#
#@return reload status as boolean
Yadd's avatar
Yadd committed
334
sub applyConf {
335
    my ( $self, $newConf ) = @_;
Yadd's avatar
Yadd committed
336 337
    my $status;

Yadd's avatar
Yadd committed
338 339 340
    # 1 Apply conf locally
    $self->api->checkConf();

Yadd's avatar
Yadd committed
341
    # Get apply section values
342 343
    my %reloadUrls
        = %{ $self->confAcc->getLocalConf( APPLYSECTION, undef, 0 ) };
Yadd's avatar
Yadd committed
344 345 346 347 348
    if ( !%reloadUrls && $newConf->{reloadUrls} ) {
        %reloadUrls = %{ $newConf->{reloadUrls} };
    }
    return {} unless (%reloadUrls);

349
    $self->ua->timeout( $newConf->{reloadTimeout} );
Yadd's avatar
Yadd committed
350 351 352

    # Parse apply values
    while ( my ( $host, $request ) = each %reloadUrls ) {
Yadd's avatar
Yadd committed
353 354 355 356 357
        my $r = HTTP::Request->new( 'GET', "http://$host$request" );
        if ( $request =~ /^https?:\/\/[^\/]+.*$/ ) {
            my $url       = URI::URL->new($request);
            my $targetUrl = $url->scheme . "://" . $host;
            $targetUrl .= ":" . $url->port if defined( $url->port );
358
            $targetUrl .= $url->full_path;
359
            $r = HTTP::Request->new( 'GET', $targetUrl,
360
                HTTP::Headers->new( Host => $url->host ) );
361 362
            if ( defined $url->userinfo
                && $url->userinfo =~ /^([^:]+):(.*)$/ )
Yadd's avatar
Yadd committed
363 364
            {
                $r->authorization_basic( $1, $2 );
365
            }
Yadd's avatar
Yadd committed
366
        }
367

Yadd's avatar
Yadd committed
368
        my $response = $self->ua->request($r);
Yadd's avatar
Yadd committed
369
        if ( $response->code != 200 ) {
370 371 372 373
            $status->{$host}
                = "Error "
                . $response->code . " ("
                . $response->message . ")";
374
            $self->logger->error( "Apply configuration for $host: error "
375 376 377
                    . $response->code . " ("
                    . $response->message
                    . ")" );
Yadd's avatar
Yadd committed
378 379 380
        }
        else {
            $status->{$host} = "OK";
381
            $self->logger->notice("Apply configuration for $host: ok");
Yadd's avatar
Yadd committed
382 383 384 385 386 387
        }
    }

    return $status;
}

388 389 390
sub diff {
    my ( $self, $req, @path ) = @_;
    return $self->sendError( $req, 'to many arguments in path info', 400 )
391 392 393
        if (@path);
    my @cfgNum
        = ( scalar( $req->param('conf1') ), scalar( $req->param('conf2') ) );
394
    my @conf;
Yadd's avatar
Yadd committed
395 396
    $self->logger->debug(" Loading confs");

397
    # Load the 2 configurations
398
    for ( my $i = 0; $i < 2; $i++ ) {
399 400 401 402 403 404 405 406 407 408
        if ( %{ $self->currentConf }
            and $cfgNum[$i] == $self->currentConf->{cfgNum} )
        {
            $conf[$i] = $self->currentConf;
        }
        else {
            $conf[$i] = $self->confAcc->getConf(
                { cfgNum => $cfgNum[$i], raw => 1, noCache => 1 } );
            return $self->sendError(
                $req,
409
                "Configuration $cfgNum[$i] not available $Lemonldap::NG::Common::Conf::msg",
410 411 412 413 414
                400
            ) unless ( $conf[$i] );
        }
    }
    require Lemonldap::NG::Manager::Conf::Diff;
415 416
    return $self->sendJSONresponse(
        $req,
417
        [   $self->Lemonldap::NG::Manager::Conf::Diff::diff(
418 419 420 421
                $conf[0], $conf[1]
            )
        ]
    );
422 423
}

424
1;