path: root/lib/session.pm

#!/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" : "";
  my $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" : "";
  my $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;