cgi-bin & lib

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;
+