# This module implements all the methods that responds to '/confs/*' requests
# It contains 2 sections:
#  - initialization methods
#  - upload method
#
# Read methods are inherited from Lemonldap::NG::Common::Conf::RESTServer
package Lemonldap::NG::Manager::Conf;

use strict;
use utf8;
use Mouse;
use Lemonldap::NG::Common::Conf::Constants;
use Lemonldap::NG::Common::UserAgent;
use Lemonldap::NG::Common::EmailTransport;
use Crypt::OpenSSL::RSA;
use Convert::PEM;
use Digest::MD5 qw(md5_base64);

use URI::URL;
use Net::SSLeay;

extends qw(
  Lemonldap::NG::Manager::Plugin
  Lemonldap::NG::Common::Conf::RESTServer
);

our $VERSION = '2.0.10';

#############################
# I. INITIALIZATION METHODS #
#############################

use constant defaultRoute => 'manager.html';

sub init {
    my ( $self, $conf ) = @_;
    $self->ua( Lemonldap::NG::Common::UserAgent->new($conf) );

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

      # READ
      # Special keys
      ->addRoute(
        confs => {
            ':cfgNum' => [
                qw(virtualHosts samlIDPMetaDataNodes samlSPMetaDataNodes
                  applicationList oidcOPMetaDataNodes oidcRPMetaDataNodes
                  casSrvMetaDataNodes casAppMetaDataNodes
                  authChoiceModules grantSessionRules combModules sfExtra
                  openIdIDPList)
            ]
        },
        ['GET']
      )

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

      # New key and conf save
      ->addRoute(
        confs => {
            newRSAKey      => 'newRSAKey',
            newCertificate => 'newCertificate',
            sendTestMail   => 'sendTestMail',
            raw            => 'newRawConf',
            '*'            => 'newConf'
        },
        ['POST']
      )

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

      # Url loader
      ->addRoute( 'prx', undef, ['POST'] );
    return 1;
}

# 35 - New Certificate on demand
#      --------------------------

##@method public PSGI-JSON-response newRSAKey($req)
# Return a hashref containing private and public keys
# The posted data must contain a JSON object containing
# {"password":"newpassword"}
#
#@param $req Lemonldap::NG::Common::PSGI::Request object
#@return PSGI JSON response
sub newCertificate {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newCertificate"',
        400 )
      if (@others);
    my $query = $req->jsonBodyToObj;

    my ( $private, $cert ) = $self->_generateX509( $query->{password} );
    my $keys = {
        'private' => $private,
        'public'  => $cert,
    };
    return $self->sendJSONresponse( $req, $keys );
}

# 35 - New RSA key pair on demand
#      --------------------------

##@method public PSGI-JSON-response newRSAKey($req)
# Return a hashref containing private and public keys
# The posted data must contain a JSON object containing
# {"password":"newpassword"}
#
#@param $req Lemonldap::NG::Common::PSGI::Request object
#@return PSGI JSON response
sub newRSAKey {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newRSAKey"', 400 )
      if (@others);
    my $rsa = Crypt::OpenSSL::RSA->generate_key(2048);

    my $query = $req->jsonBodyToObj;
    my $keys  = {
        'private' => $rsa->get_private_key_string(),
        'public'  => $rsa->get_public_key_x509_string(),
        'hash' => md5_base64($rsa->get_public_key_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 );
}

# This function does the dirty X509 work,
# mostly copied from IO::Socket::SSL::Utils
# and adapter to work on old platforms (CentOS7)

sub _generateX509 {
    my ( $self, $password ) = @_;
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    my $conf = $self->confAcc->getConf();

    # Generate 2048 bits RSA key
    my $key = Net::SSLeay::EVP_PKEY_new();
    Net::SSLeay::EVP_PKEY_assign_RSA( $key,
        Net::SSLeay::RSA_generate_key( 2048, 0x10001 ) );

    my $cert = Net::SSLeay::X509_new();

    # Serial
    Net::SSLeay::ASN1_INTEGER_set(
        Net::SSLeay::X509_get_serialNumber($cert),
        rand( 2**32 ),
    );

    # Version
    Net::SSLeay::X509_set_version( $cert, 2 );

    # Make it last 20 years
    Net::SSLeay::ASN1_TIME_set( Net::SSLeay::X509_get_notBefore($cert),
        time() );
    Net::SSLeay::ASN1_TIME_set( Net::SSLeay::X509_get_notAfter($cert),
        time() + 20 * 365 * 86400 );

    # set subject
    my $portal_uri  = new URI::URL( $conf->{portal} || "http://localhost" );
    my $portal_host = $portal_uri->host;
    my $subj_e      = Net::SSLeay::X509_get_subject_name($cert);
    my $subj        = { commonName => $portal_host, };

    while ( my ( $k, $v ) = each %$subj ) {

        # Not everything we get is nice - try with MBSTRING_UTF8 first and if it
        # fails try V_ASN1_T61STRING and finally V_ASN1_OCTET_STRING
        Net::SSLeay::X509_NAME_add_entry_by_txt( $subj_e, $k, 0x1000, $v, -1,
            0 )
          or
          Net::SSLeay::X509_NAME_add_entry_by_txt( $subj_e, $k, 20, $v, -1, 0 )
          or
          Net::SSLeay::X509_NAME_add_entry_by_txt( $subj_e, $k, 4, $v, -1, 0 )
          or croak( "failed to add entry for $k - "
              . Net::SSLeay::ERR_error_string( Net::SSLeay::ERR_get_error() ) );
    }

    # Set to self-sign
    Net::SSLeay::X509_set_pubkey( $cert, $key );
    Net::SSLeay::X509_set_issuer_name( $cert,
        Net::SSLeay::X509_get_subject_name($cert) );

    # Sign with default alg
    Net::SSLeay::X509_sign( $cert, $key, 0 );

    my $strCert = Net::SSLeay::PEM_get_string_X509($cert);
    my $strPrivate;
    if ($password) {
        $strPrivate = Net::SSLeay::PEM_get_string_PrivateKey( $key, $password );
    }
    else {
        $strPrivate = Net::SSLeay::PEM_get_string_PrivateKey($key);
    }

    # Free OpenSSL objects
    Net::SSLeay::X509_free($cert);
    Net::SSLeay::EVP_PKEY_free($key);

    return ( $strPrivate, $strCert );
}

#      Sending a test Email
#      --------------------

##@method public PSGI-JSON-response sendTestMail($req)
# Sends a test email to the provided address
# The posted data must contain a JSON object containing
# {"dest":"target@example.com"}
#
#@param $req Lemonldap::NG::Common::PSGI::Request object
#@return PSGI JSON response
sub sendTestMail {
    my ( $self, $req, @others ) = @_;
    return $self->sendError( $req, 'There is no subkey for "sendTestMail"',
        400 )
      if (@others);
    my $dest = $req->jsonBodyToObj->{dest};
    unless ($dest) {
        $self->logger->debug("Missing dest parameter for sending test mail");
        return $self->sendJSONresponse(
            $req,
            {
                success => \0,
                error   => "You must provide an email address"
            }
        );
    }
    my $conf = $self->confAcc->getConf();

    # Try to send test Email
    $self->logger->info("Sending test email to $dest");
    eval {
        Lemonldap::NG::Common::EmailTransport::sendTestMail( $conf, $dest );
    };
    my $error   = $@;
    my $success = ( $error ? 0 : 1 );

    $self->logger->debug("Email was sent") unless $error;
    return $self->sendJSONresponse(
        $req,
        {
            success => \$success,
            ( $error ? ( error => $error ) : () )
        }
    );
}

# 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 )
      if (@others);
    my $query = $req->jsonBodyToObj;
    return $self->sendError( $req, 'Missing parameter', 400 )
      unless ( $query->{url} );
    return $self->sendError( $req, 'Bad parameter', 400 )
      unless ( $query->{url} =~ m#^(?:f|ht)tps?://\w# );
    $self->ua->timeout(10);

    my $response = $self->ua->get( $query->{url} );
    unless ( $response->code == 200 ) {
        return $self->sendError( $req,
            $response->code . " (" . $response->message . ")", 400 );
    }
    unless ( $response->header('Content-Type') =~
        m#^(?:application/json|(?:application|text)/.*xml).*$# )
    {
        return $self->sendError( $req,
            'Content refused for security reason (neither XML or JSON)', 400 );
    }
    return $self->sendJSONresponse( $req, { content => $response->content } );
}

######################
# IV. Upload methods #
######################

# In this section, 3 methods:
#  - getConfByNum: override SUPER method to be able to use Zero
#  - newConf(), load a new configuration and invokes reloadUrls
#  - newRawConf(): restore a saved conf

sub getConfByNum {
    my ( $self, $cfgNum, @args ) = @_;
    unless ($self->currentConf
        and %{ $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 );
            return undef unless ( defined $tmp );
        }
    }
    return $cfgNum;
}

## @method PSGI-JSON-response newConf($req)
# Call Lemonldap::NG::Manager::Conf::Parser to parse new configuration and store
# it
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@return PSGI JSON response
sub newConf {
    my ( $self, $req, @other ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newConf"', 400 )
      if (@other);

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

    # Verify that cfgNum has been asked
    unless ( defined $req->params('cfgNum') ) {
        return $self->sendError( $req, "Missing configuration number", 400 );
    }

    # Set current conf to cfgNum
    unless ( defined $self->getConfByNum( $req->params('cfgNum') ) ) {
        return $self->sendError(
            $req,
            "Configuration "
              . $req->params('cfgNum')
              . " not available "
              . $Lemonldap::NG::Common::Conf::msg,
            400
        );
    }

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

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

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

    my $res = { result => $parser->check( $self->p ) };

    # "message" fields: note that words enclosed by "__" (__word__) will be
    # translated
    $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 } );
        }
    }
    if ( $res->{result} ) {
        if ( $self->p->{demoMode} ) {
            $res->{message} = '__demoModeOn__';
        }
        else {
            my %args;
            $args{force} = 1 if ( $req->params('force') );
            my $s = CONFIG_WAS_CHANGED;
            $s = $self->confAcc->saveConf( $parser->newConf, %args )
              unless ( @{ $parser->{needConfirmation} } && !$args{force} );
            if ( $s > 0 ) {
                $self->userLogger->notice(
                    'User ' . $self->p->userId($req) . " has stored conf $s" );
                $res->{result} = 1;
                $res->{cfgNum} = $s;
                if ( my $status = $self->applyConf( $parser->newConf ) ) {
                    push @{ $res->{details}->{__applyResult__} },
                      { message => "$_: $status->{$_}" }
                      foreach ( keys %$status );
                }
            }
            else {
                $self->userLogger->notice(
                    'Saving attempt rejected, asking for confirmation to '
                      . $self->p->userId($req) );
                $res->{result} = 0;
                if ( $s == CONFIG_WAS_CHANGED ) {
                    $res->{needConfirm} = 1;
                    $res->{message} .= '__needConfirmation__'
                      unless @{ $parser->{needConfirmation} };
                }
                else {
                    $res->{message} = $Lemonldap::NG::Common::Conf::msg;
                }
            }
        }
    }
    return $self->sendJSONresponse( $req, $res );
}

## @method PSGI-JSON-response newRawConf($req)
# Store directly raw configuration
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@return PSGI JSON response
sub newRawConf {
    my ( $self, $req, @other ) = @_;
    return $self->sendError( $req, 'There is no subkey for "newConf"', 400 )
      if (@other);

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

    my $res = {};
    if ( $self->p->{demoMode} ) {
        $res->{message} = '__demoModeOn__';
    }
    else {
        # 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 );
        if ( $s > 0 ) {
            $self->userLogger->notice( 'User '
                  . $self->p->userId($req)
                  . " has stored (raw) conf $s" );
            $res->{result} = 1;
            $res->{cfgNum} = $s;
        }
        else {
            $self->userLogger->notice(
                'Raw saving attempt rejected, asking for confirmation to '
                  . $self->p->userId($req) );
            $res->{result}      = 0;
            $res->{needConfirm} = 1 if ( $s == CONFIG_WAS_CHANGED );
            $res->{message} .= '__needConfirmation__';
        }
    }
    return $self->sendJSONresponse( $req, $res );
}

sub diff {
    my ( $self, $req, @path ) = @_;
    return $self->sendError( $req, 'to many arguments in path info', 400 )
      if (@path);
    my @cfgNum =
      ( scalar( $req->param('conf1') ), scalar( $req->param('conf2') ) );
    my @conf;
    $self->logger->debug(" Loading confs");

    # Load the 2 configurations
    for ( my $i = 0 ; $i < 2 ; $i++ ) {
        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,
"Configuration $cfgNum[$i] not available $Lemonldap::NG::Common::Conf::msg",
                400
            ) unless ( $conf[$i] );
        }
    }
    require Lemonldap::NG::Manager::Conf::Diff;
    return $self->sendJSONresponse(
        $req,
        [
            $self->Lemonldap::NG::Manager::Conf::Diff::diff(
                $conf[0], $conf[1]
            )
        ]
    );
}

1;