Process.pm 9.15 KB
Newer Older
Yadd's avatar
Yadd committed
1 2
package Lemonldap::NG::Portal::Main::Process;

Yadd's avatar
Yadd committed
3 4 5 6
our $VERSION = '2.0.0';

package Lemonldap::NG::Portal::Main;

Yadd's avatar
Yadd committed
7
use strict;
Yadd's avatar
Yadd committed
8
use MIME::Base64;
Yadd's avatar
Yadd committed
9
use POSIX qw(strftime);
Yadd's avatar
Yadd committed
10

Yadd's avatar
Yadd committed
11 12 13 14 15 16 17 18 19 20 21 22 23
# Main method
# -----------
# Launch all methods declared in request "steps" array. Methods can be
# declared by their name (in Lemonldap::NG::Portal::Main namespace) or point
# to a subroutine (see Lemonldap::NG::Portal::Main::Run.pm)

sub process {
    my ( $self, $req ) = @_;

    #$req->error(PE_OK);
    my $err = PE_OK;
    while ( my $sub = shift @{ $req->steps } ) {
        if ( ref $sub ) {
Yadd's avatar
Yadd committed
24
            $self->lmLog( "Processing code ref", 'debug' );
Yadd's avatar
Yadd committed
25 26 27
            last if ( $sub->($req) );
        }
        else {
Yadd's avatar
Yadd committed
28
            $self->lmLog( "Processing $sub", 'debug' );
Yadd's avatar
Yadd committed
29 30 31 32 33 34
            last if ( $err = $self->$sub($req) );
        }
    }
    return $err;
}

Yadd's avatar
Yadd committed
35 36 37 38 39 40 41
# First process block: check args
# -------------------------------

# For post requests, parse datas
sub restoreArgs {
    my ( $self, $req ) = @_;
    $req->parseBody;
Yadd's avatar
Yadd committed
42
    $req->mustRedirect(1);
Yadd's avatar
Yadd committed
43 44 45 46 47 48
    return ( %{ $req->params } ? PE_OK : PE_FORMEMPTY );
}

# Verify url parameter
sub controlUrl {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
49
    $req->{datas}->{_url} ||= '';
Yadd's avatar
Yadd committed
50 51
    if ( my $url = $req->param('url') ) {

Yadd's avatar
Yadd committed
52 53 54 55 56
        # REJECT NON BASE64 URL
        if ( $req->urlNotBase64 ) {
            $req->datas->{urldc} = $url;
        }
        else {
Yadd's avatar
Yadd committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
            if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
                $self->lmLog(
                    "Value must be in BASE64 (param: url | value: $url)",
                    "warn" );
                return PE_BADURL;
            }
            $req->datas->{urldc} = decode_base64($url);
            $req->datas->{urldc} =~ s/[\r\n]//sg;
        }

        # For logout request, test if Referer comes from an authorizated site
        my $tmp =
          ( $req->param('logout') ? $ENV{HTTP_REFERER} : $req->datas->{urldc} );

        # XSS attack
        if (
            $self->checkXSSAttack(
                $req->param('logout') ? 'HTTP Referer' : 'urldc',
                $req->datas->{urldc}
            )
          )
        {
            delete $req->datas->{urldc};
            return PE_BADURL;
        }

        # Non protected hosts
        if ( $tmp and !$self->isTrustedUrl($tmp) ) {
            $self->lmLog(
                "URL contains a non protected host (param: "
                  . ( $req->param('logout') ? 'HTTP Referer' : 'urldc' )
                  . " | value: $tmp)",
                "warn"
            );
            delete $req->datas->{urldc};
            return PE_BADURL;
        }

        $req->datas->{_url} = $url;
    }

    PE_OK;
}

Yadd's avatar
Yadd committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
# Check value to detect XSS attack
# @param name Parameter name
# @param value Parameter value
# @return 1 if attack detected, 0 else
sub checkXSSAttack {
    my ( $self, $name, $value ) = @_;

    # Empty values are not bad
    return 0 unless $value;

    # Test value
    if ( $value =~ m/(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ ) {
        $self->lmLog( "XSS attack detected (param: $name | value: $value)",
            "warn" );
        return $self->conf->{checkXSS};
    }

    return 0;
}

Yadd's avatar
Yadd committed
121 122 123
# Second block: auth process (call auth or userDB object)
# -------------------------------------------------------

Yadd's avatar
Yadd committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
sub extractFormInfo {
    my $self = shift;
    return $self->_authentication->extractFormInfo(@_);
}

sub getUser {
    my $self = shift;
    return $self->_userDB->getUser(@_);
}

sub authenticate {
    my $self = shift;
    return $self->_authentication->authenticate(@_);
}

Yadd's avatar
Yadd committed
139 140
# Third block: Session data providing
# -----------------------------------
Yadd's avatar
Yadd committed
141 142 143 144

sub setSessionInfo {
    my ( $self, $req ) = @_;

Yadd's avatar
Yadd committed
145 146 147
    # Set _user
    $req->{sessionInfo}->{_user} = $req->{user};

Yadd's avatar
Yadd committed
148
    # Get the current user module
Yadd's avatar
Yadd committed
149 150
    $req->{sessionInfo}->{_auth}   = $self->getModule( $req, "auth" );
    $req->{sessionInfo}->{_userDB} = $self->getModule( $req, "user" );
Yadd's avatar
Yadd committed
151 152 153 154 155 156 157 158 159 160 161 162 163

    # Store IP address from remote address or X-FORWARDED-FOR header
    $req->{sessionInfo}->{ipAddr} = $req->remote_ip;

    # Date and time
    if ( $self->conf->{updateSession} ) {
        $req->{sessionInfo}->{updateTime} =
          strftime( "%Y%m%d%H%M%S", localtime() );
    }
    else {
        $req->{sessionInfo}->{_utime} ||= time();
        $req->{sessionInfo}->{startTime} =
          strftime( "%Y%m%d%H%M%S", localtime() );
Yadd's avatar
Yadd committed
164 165
        $req->{sessionInfo}->{_lastSeen} = time()
          if $self->conf->{timeoutActivity};
Yadd's avatar
Yadd committed
166 167 168 169 170 171 172 173 174 175 176 177 178
    }

    # Get environment variables matching exportedVars
    foreach ( keys %{ $self->conf->{exportedVars} } ) {
        if ( my $tmp = $ENV{ $self->conf->{exportedVars}->{$_} } ) {
            $tmp =~ s/[\r\n]/ /gs;
            $req->{sessionInfo}->{$_} = $tmp;
        }
    }

    # Store URL origin in session
    $req->{sessionInfo}->{_url} = $req->datas->{urldc};

179
    # Share sessionInfo with underlying handler (needed for safe jail)
Yadd's avatar
Yadd committed
180
    HANDLER->datas( $req->{sessionInfo} );
181

Yadd's avatar
Yadd committed
182
    # Call UserDB setSessionInfo
Yadd's avatar
Yadd committed
183
    return $self->_userDB->setSessionInfo($req);
Yadd's avatar
Yadd committed
184 185 186 187 188

    PE_OK;
}

sub setMacros {
Yadd's avatar
Yadd committed
189 190
    my ( $self, $req ) = @_;
    foreach ( sort keys %{ $self->_macros } ) {
Yadd's avatar
Yadd committed
191
        $req->{sessionInfo}->{$_} = $self->_macros->{$_}->();
Yadd's avatar
Yadd committed
192 193
    }
    PE_OK;
Yadd's avatar
Yadd committed
194 195 196
}

sub setGroups {
Yadd's avatar
Yadd committed
197 198
    my ( $self, $req ) = @_;
    return $self->_userDB->setGroups(@_);
Yadd's avatar
Yadd committed
199 200 201
}

sub setPersistentSessionInfo {
Yadd's avatar
Yadd committed
202
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
203

Yadd's avatar
Yadd committed
204 205 206
    # Do not restore infos if session already opened
    unless ( $req->{id} ) {
        my $key = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
Yadd's avatar
Yadd committed
207

Yadd's avatar
Yadd committed
208
        return PE_OK unless ( $key and length($key) );
Yadd's avatar
Yadd committed
209

Yadd's avatar
Yadd committed
210
        my $persistentSession = $self->getPersistentSession($key);
Yadd's avatar
Yadd committed
211

Yadd's avatar
Yadd committed
212 213 214
        if ($persistentSession) {
            $self->lmLog( "Persistent session found for $key", 'debug' );
            foreach my $k ( keys %{ $persistentSession->data } ) {
Yadd's avatar
Yadd committed
215

Yadd's avatar
Yadd committed
216 217 218 219 220 221 222
                # Do not restore some parameters
                next if $k =~ /^_(?:utime|session_(?:u?id|kind))$/;
                $self->lmLog( "Restore persistent parameter $k", 'debug' );
                $req->{sessionInfo}->{$k} = $persistentSession->data->{$k};
            }
        }
    }
Yadd's avatar
Yadd committed
223

Yadd's avatar
Yadd committed
224
    PE_OK;
Yadd's avatar
Yadd committed
225 226 227
}

sub setLocalGroups {
Yadd's avatar
Yadd committed
228 229
    my ( $self, $req ) = @_;
    foreach ( sort keys %{ $self->_groups } ) {
Yadd's avatar
Yadd committed
230
        if ( $self->_groups->{$_}->() ) {
Yadd's avatar
Yadd committed
231 232 233 234 235 236 237 238 239 240 241 242
            $req->{sessionInfo}->{groups} .=
              $self->conf->{multiValuesSeparator} . $_;
            $req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
        }
    }

    # Clear values separator at the beginning
    if ( $req->{sessionInfo}->{groups} ) {
        $req->{sessionInfo}->{groups} =~
          s/^\Q$self->conf->{multiValuesSeparator}\E//o;
    }
    PE_OK;
Yadd's avatar
Yadd committed
243 244 245
}

sub store {
Yadd's avatar
Yadd committed
246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
    my ( $self, $req ) = @_;

    # Now, user is authenticated => inform handler
    $req->userData( $req->sessionInfo );

    # Create second session for unsecure cookie
    if ( $self->conf->{securedCookie} == 2 ) {
        my $session2 = $self->getApacheSession( undef, 1 );

        my %infos = %{ $req->{sessionInfo} };
        $infos{_httpSessionType} = 1;

        $session2->update( \%infos );

        $req->{sessionInfo}->{_httpSession} = $session2->id;
    }

    # Main session
    my $session = $self->getApacheSession( $req->{id}, 0, $self->{force} );
    return PE_APACHESESSIONERROR unless ($session);
Yadd's avatar
Yadd committed
266
    $req->id( $session->{id} );
Yadd's avatar
Yadd committed
267 268 269 270 271 272 273 274 275 276 277 278

    # Compute unsecure cookie value if needed
    if ( $self->conf->{securedCookie} == 3 ) {
        $req->{sessionInfo}->{_httpSession} =
          $self->conf->{cipher}->encryptHex( $self->{id}, "http" );
    }

    # Fill session
    my $infos = {};
    foreach my $k ( keys %{ $req->{sessionInfo} } ) {
        next unless defined $req->{sessionInfo}->{$k};
        my $displayValue = $req->{sessionInfo}->{$k};
Yadd's avatar
Yadd committed
279 280 281
        if (    $self->conf->{hiddenAttributes}
            and $self->conf->{hiddenAttributes} =~ /\b$k\b/ )
        {
Yadd's avatar
Yadd committed
282 283 284 285
            $displayValue = '****';
        }
        $self->lmLog( "Store $displayValue in session key $k", 'debug' );
        $self->_dump($displayValue) if ref($displayValue);
Yadd's avatar
Yadd committed
286
        $infos->{$k} = $req->{sessionInfo}->{$k};
Yadd's avatar
Yadd committed
287 288 289 290
    }
    $session->update($infos);

    PE_OK;
Yadd's avatar
Yadd committed
291 292 293
}

sub buildCookie {
Yadd's avatar
Yadd committed
294
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
295 296 297 298 299
    push @{ $req->respHeaders },
      'Set-Cookie' => $self->cookie(
        name     => $self->conf->{cookieName},
        value    => $req->{id},
        domain   => $self->conf->{domain},
Yadd's avatar
Yadd committed
300
        path     => "/",
Yadd's avatar
Yadd committed
301 302 303
        secure   => $self->conf->{securedCookie},
        HttpOnly => $self->conf->{httpOnly},
        expires  => $self->conf->{cookieExpiration},
Yadd's avatar
Yadd committed
304 305
      );
    if ( $self->conf->{securedCookie} >= 2 ) {
Yadd's avatar
Yadd committed
306 307 308 309 310
        push @{ $req->respHeaders },
          'Set-Cookie' => $self->cookie(
            name     => $self->conf->{cookieName} . "http",
            value    => $req->{sessionInfo}->{_httpSession},
            domain   => $self->conf->{domain},
Yadd's avatar
Yadd committed
311 312
            path     => "/",
            secure   => 0,
Yadd's avatar
Yadd committed
313 314
            HttpOnly => $self->conf->{httpOnly},
            expires  => $self->conf->{cookieExpiration},
Yadd's avatar
Yadd committed
315 316 317 318
            @_,
          );
    }
    PE_OK;
Yadd's avatar
Yadd committed
319 320 321
}

sub cookie {
Yadd's avatar
Yadd committed
322 323 324 325 326 327
    my ( $self, %h ) = @_;
    my @res;
    $res[0] = "$h{name}" or die("name required");
    $res[0] .= "=$h{value}";
    foreach (qw(domain path expires max_age)) {
        my $f = $_;
Yadd's avatar
Yadd committed
328 329
        $f =~ s/_/-/g;
        push @res, "$f=$h{$_}" if ( $h{$_} );
Yadd's avatar
Yadd committed
330 331
    }
    return join( '; ', @res );
Yadd's avatar
Yadd committed
332 333 334
}

1;