Conf.pm 13.2 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;
Xavier Guimard's avatar
Xavier Guimard committed
10
use utf8;
11 12
use Mouse;
use Lemonldap::NG::Common::Conf::Constants;
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

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

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

use constant defaultRoute => 'manager.html';

30 31
has ua => ( is => 'rw' );

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

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

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

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

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

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

Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
71 72
      # Url loader
      ->addRoute( 'prx', undef, ['POST'] );
73 74
}

75 76 77
# 35 - New RSA key pair on demand
#      --------------------------

Xavier Guimard's avatar
Xavier Guimard committed
78
##@method public PSGI-JSON-response newRSAKey($req)
79
# Return a hashref containing private and public keys
Xavier Guimard's avatar
Xavier Guimard committed
80
# The posted data must contain a JSON object containing
81 82
# {"password":"newpassword"}
#
Xavier Guimard's avatar
Xavier Guimard committed
83 84
#@param $req Lemonldap::NG::Common::PSGI::Request object
#@return PSGI JSON response
85 86 87
sub newRSAKey {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newRSAKey"', 400 )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
88
      if (@others);
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 );
}

Xavier Guimard's avatar
Xavier Guimard 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 )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
130
      if (@others);
Xavier Guimard's avatar
Xavier Guimard committed
131 132
    my $query = $req->jsonBodyToObj;
    return $self->sendError( $req, 'Missing parameter', 400 )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
133
      unless ( $query->{url} );
Xavier Guimard's avatar
Xavier Guimard committed
134
    return $self->sendError( $req, 'Bad parameter', 400 )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
135
      unless ( $query->{url} =~ m#^(?:f|ht)tps?://\w# );
136
    $self->ua->timeout(10);
Xavier Guimard's avatar
Xavier Guimard committed
137

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

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

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

163 164 165 166 167 168 169 170 171 172 173 174 175
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 );
176
            return undef unless ( defined $tmp );
177 178 179 180 181
        }
    }
    return $cfgNum;
}

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

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

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

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

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

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

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

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

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

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

    # 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 {
306 307 308
        # 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 );
309
        if ( $s > 0 ) {
310
            $self->userLogger->notice(
Xavier Guimard's avatar
Xavier Guimard committed
311
                'User ' . $self->userId($req) . " has stored (raw) conf $s" );
312 313 314 315
            $res->{result} = 1;
            $res->{cfgNum} = $s;
        }
        else {
316
            $self->userLogger->notice(
Xavier Guimard's avatar
Xavier Guimard committed
317
                'Raw saving attempt rejected, asking for confirmation to '
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
318
                  . $self->userId($req) );
319 320 321 322 323 324 325 326
            $res->{result} = 0;
            $res->{needConfirm} = 1 if ( $s == CONFIG_WAS_CHANGED );
            $res->{message} .= '__needConfirmation__';
        }
    }
    return $self->sendJSONresponse( $req, $res );
}

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

Xavier Guimard's avatar
Xavier Guimard committed
336 337 338
    # 1 Apply conf locally
    $self->api->checkConf();

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

347
    $self->ua->timeout( $newConf->{reloadTimeout} );
348 349 350

    # Parse apply values
    while ( my ( $host, $request ) = each %reloadUrls ) {
Xavier Guimard's avatar
Xavier Guimard committed
351 352 353 354 355
        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 );
356
            $targetUrl .= $url->full_path;
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
357 358
            $r =
              HTTP::Request->new( 'GET', $targetUrl,
359
                HTTP::Headers->new( Host => $url->host ) );
360 361
            if ( defined $url->userinfo
                && $url->userinfo =~ /^([^:]+):(.*)$/ )
Xavier Guimard's avatar
Xavier Guimard committed
362 363
            {
                $r->authorization_basic( $1, $2 );
364
            }
365
        }
366

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

    return $status;
}

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

394
    # Load the 2 configurations
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
395
    for ( my $i = 0 ; $i < 2 ; $i++ ) {
396 397 398 399 400 401 402 403 404 405
        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,
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
406
"Configuration $cfgNum[$i] not available $Lemonldap::NG::Common::Conf::msg",
407 408 409 410 411
                400
            ) unless ( $conf[$i] );
        }
    }
    require Lemonldap::NG::Manager::Conf::Diff;
412 413
    return $self->sendJSONresponse(
        $req,
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
414 415
        [
            $self->Lemonldap::NG::Manager::Conf::Diff::diff(
416 417 418 419
                $conf[0], $conf[1]
            )
        ]
    );
420 421
}

422
1;