diff options
Diffstat (limited to 'lib/session.pm')
| -rw-r--r-- | lib/session.pm | 262 |
1 files changed, 262 insertions, 0 deletions
diff --git a/lib/session.pm b/lib/session.pm new file mode 100644 index 0000000..2074ee4 --- /dev/null +++ b/lib/session.pm @@ -0,0 +1,262 @@ +#!/usr/bin/perl +######################################### +# _session.txt +# coordinates all raw input/output +# plus formatting and headers for some reason + +use DBI; +use Image::Size; +use constants; + +our $base_path = $BUCKY_CONFIG->{BASE_PATH}; +our $temp_path = $base_path."incoming"; +our $data_path = $base_path."data"; +our $live_path = "/bucky/data"; + +our $USER = -1; + +our $input = getargs( { base => $temp_path, file => "temp_[(field)]" } ); + +our $DEBUG = $ENV{REQUEST_URI} =~ /debug/; +if ($DEBUG) { print "Content-type: text/html\n\n<tt>ENTERING DEBUG MODE . . .</tt><p>"; } + +$input->{object_from_uri} = get_object_from_uri(); +$input->{script_from_uri} = get_script_from_uri(); + +our $cookies = getCookies(); + +our $dsn = "DBI:mysql:$BUCKY_DB:localhost;mysql_read_default_file=$BUCKY_DB_CNF"; +our ($dbh, $sth); + +# extract script from URI +sub get_script_from_uri + { + my $request_uri = $ENV{REQUEST_URI}; + # /profile + # /profile/ + # /profile/jules + # /profile/jules/ + # /profile?username=jules + # /profile/jules?username=rakubian + + my ($script, $object) = $request_uri =~ /^$BUCKY\/(\w+)\/?(\w+)?\??/; + return $script if (length($script) > 0); + return undef; + } + +# extract object from URI, if using / URI delimiters +sub get_object_from_uri + { + my $request_uri = $ENV{REQUEST_URI}; + + my ($method, $object) = $request_uri =~ /^$BUCKY\/(\w+)\/([a-zA-Z0-9]+)/; + + # only return object if it exists and has a length > 0 + print "method: $method<br>\n" if ($DEBUG); + print "view: $object<br>\n" if ($DEBUG); + + return $object if (length($object) > 0); + return undef; + +# return $object || undef; +# return ""; + } + +# check cookies, return userhash, lastlog +sub checkin + { + my $lastlog; + + my $user = check_cookie(); + if (ref($user) && $user != -1) + { print "<br>HELLO $user->{username}<br>" if $DEBUG; } + elsif ($ENV{REQUEST_URI} =~ /$BUCKY\/invite/) + { return ( -1 ); } + else + { logout(0); } + + $lastlog = lastlog($user); + touch_user($user->{id}) if ($user != -1); + return ($user, $lastlog); + } + +sub check_cookie + { + if (exists($cookies->{name})) + { + if ($cookies->{name} && $cookies->{name} ne 'unknown') + { $user = auth($cookies->{name}, $cookies->{pass}); } + elsif ($ENV{REQUEST_URI} =~ /$BUCKY\/invite/) + { return ( -1 ); } + } + } +# check passwords, set cookie +sub auth + { + my ($inname, $inpass) = @_; + + $inname = lc($inname); +# $inname = "marc"; + + my ($dbuh) = get_user($inname); + + if ($dbuh != -1 && $dbuh->{ulevel} > 0 && $dbuh->{password} eq $inpass) + { + my $forever = check_key($dbuh->{boxes}, "nologout"); + setCookie( { name => "name", value => $inname, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN, nologout => $forever } ); + setCookie( { name => "pass", value => $inpass, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN, nologout => $forever } ); +# setCookie("name", $inname, "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); +# setCookie("pass", $inpass, "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); + + return ($dbuh); + } + else +# { return -1; } + { logout(0); } + } + +sub logout + { + my $error = shift; + my $lender = undef; + my $s = $ENV{'HTTPS'} eq "on" ? "s" : ""; + + setCookie( { name => "name", value => undef, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN } ); + setCookie( { name => "pass", value => undef, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN } ); + +# setCookie("name", "", "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); +# setCookie("pass", "", "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); + + print "Location: http$s://$BUCKY_HOST$BUCKY/login"; + + if ($ENV{REQUEST_URI} !~ /login/ && $ENV{REQUEST_URI} !~ /logout/ && $ENV{REQUEST_URI} ne "$BUCKY/index" && $ENV{REQUEST_URI} ne "/bucky/") + { + $lender .= "redir=$ENV{REQUEST_URI}"; + } + + if (defined($lender) || $error > 0) + { + print "?"; + print "error=$error&" if ($error > 0); + print $lender; + } + + print "\n\n"; + + $dbh->disconnect() if (defined($dbh)); + exit (0); + } + +sub nice_redirect + { + my $uri = ''; + if ($input->{redir} && $input->{redir} ne "/bucky/") + { + redirect($input->{redir}); + } + else + { + redirect("$BUCKY/index"); + } + } + +sub redirect + { + my $uri = shift; + my $s = ($ENV{'HTTPS'} eq "on" || exists($input->{secure})) ? "s" : ""; + print "Location: http$s://$BUCKY_HOST$uri\n\n"; + $dbh->disconnect() if (defined($dbh)); + exit (0); + } + +sub error + { + my $reason = shift; +# my $f = get_random_flagged_image(); + if (defined($USER) && $USER != -1) + { + header("<center>error: $reason</center>"); + print qq(<center>); + print qq(<div align="center" style="max-width: 390px;">); + print qq(<hr noshade color="$BUCKY_COLOR_HR">); + my $filename = lc($f->{filename}); + print qq!<img src="/bucky/error.jpg" class="thumb"></a><br>\n!; + print "<p>sorry, there was an <b>error:</b><p><big>$reason</big><p>"; + print qq!<a href="javascript:history.go(-1)"><big><b>go back</b></big></a> | <a href="$BUCKY/index">home</a>\n!; + print qq(</div>); + print qq(</center>); + } + else + { + header("error: $reason"); + print "there was an <b>error:</b><p>$reason<p>"; + } + footer(); + $dbh->disconnect() if (defined($dbh)); + exit(1); + } + +sub corral + { + my ($things, $key) = @_; + my @values; + foreach my $k (sort keys %$things) + { + next unless ($k =~ /^$key/); + push @values, $things->{$k}; + } + return sort @values; + } + +# keys -- for storing arrays of ids + +sub split_keys + { + my ($string) = @_; + my @out; + foreach my $v (split(" ", $string)) + { + if (defined($v)) + { push @out, $v; } + } + return @out; + } + +sub check_key + { + my ($string, $key) = @_; + if ($string =~ /\s$key\s/) + { return 1; } + else + { return 0; } + } + +sub add_key + { + my ($string, $key) = @_; + $string .= " $key " unless (check_key($string, $key)); + $string =~ s/( )+/ /g; + return $string; + } + +sub toggle_key + { + my ($string, $key) = @_; + if (check_key($string, $key)) + { $string =~ s/ $key / /; } + else + { $string .= " $key "; } + $string =~ s/( )+/ /g; + return $string; + } + +sub delete_key + { + my ($string, $key) = @_; + $string =~ s/ $key / /; + $string =~ s/( )+/ /g; + return $string; + } + +1; + |