Welcome to the Second Life Forums Archive

These forums are CLOSED. Please visit the new forums HERE

Web Logging from inside SL

Jarod Godel
Utilitarian
Join date: 6 Nov 2003
Posts: 729
01-23-2004 14:11
Second Log is a system that I have been using to post blog-like entries while in the game. It's a combination of LSL and Perl scripting. I tried selling it in world, but couldn't get the Content to display properly. So, I've decided to give it away here (where I hope it's okay to post code). edit-link removed. ne.

Second Log works in three parts: The first part is the in-game client that you talk to, written in LSL. The second part is the daemon that checks for recieved email, written in Perl. The third part is the CGI script that both the daemon talks to to update and the user views from a browser, written in Perl.

Here's the first part:

CODE

// Global
string blogit;
string user;
string title;
string mail = "email@address.com";
string domain = "domain.com";
string nowner;
float num = 0;

default
{
state_entry()
{
// Defines nowner
nowner = llKey2Name(llGetOwner());

// Makes sure it's on.
llWhisper(0, "Ready to record!");

// Listen state
state ListenState;
}
}

// The listen state
state ListenState
{
state_entry()
{
llListen(0, nowner, NULL_KEY, "");
}

listen(integer channel, string name, key id, string message)
{
// Variables
list thelist = llParseString2List(message, [" "], [""]);
string cmd = llList2String(thelist, 0);
integer x = 1;

// The slog command
if (cmd == "/slog")
{
// Gets the specific slog command
string cmdb = llList2String(thelist, 1);

// The entry command that lets you compile an entry
if (cmdb == "entry")
{
// Compiles the message text
string tstr;
integer tcnt = 2;

while (llList2String(thelist, tcnt) != "")
{
tstr = tstr + llList2String(thelist, tcnt) + " ";
tcnt++;
}

blogit = blogit + " " + tstr;
llWhisper(0, blogit);
}

// The send command
else if (cmdb == "send")
{
llEmail(mail, "Second Log", nowner + ":" + blogit);
llWhisper(0, "Message sent.");

// Cleans the slate
blogit = "";
user = "";
}

// Shows the url
else if (cmdb == "url")
{
llSay(0, domain);
}

}
}
}


Here's the second part:

CODE

#/usr/bin/perl -w
# Second Log Daemon
# by: Andrew Burton - [email]tuglyraisin@aol.com[/email]
# SL: Jarod Godel - Teal 204, 84
#####
# This is the daemon that check email and sends data to the sl.cgi script.
#####

#####
# modules
use strict;
use LWP 5.64;
use HTTP::Response;
use Net::POP3;

#####
# global variables
# web variables
my $domain = 'www.domain.com';
my $cgiurl = 'cgi-bin/sl';
my $script = 'sl.cgi';

# mail variables
my $id = $ARGV[0];
my $pw = $ARGV[1];
my $servername = 'mail.domain.com';

# constructed variables
my $webserver = 'http://' . $domain . '/' . $cgiurl . '/' . $script;

# miscellaneous variables
my $check = 0;
my $messtext = '';
my %entry = ();

# main loop
while (1) {

# Creates the connection
my $pop = Net::POP3->new($servername, Default => 1);
unless ($pop) { die "Cannot connect to POP3 server.\n"; }

# Logs in
my $logcheck = $pop->login($id, $pw);
unless ($logcheck) { die "Die could not login.\n"; }

my $msg = $pop->list();
unless ($msg =~ m/0E0/i) {
foreach my $msgid (keys(%$msg)) {
my $msg_sender = $pop->get($msgid);
foreach my $mline (@$msg_sender) {
if ($check == 1) {
unless ($mline =~ m/^\n/) {
$messtext = $messtext . $mline;
}
}

if ($mline =~ m/SLog/i) { $check = 1; }
}

my ($dreg, $dloc, $dent) = split(/\n/, $messtext);

my ($jnka, $region, $jnkb) = split (/ /, $dreg);
my ($sluser, $slentry) = split (/\: /, $dent, 2);

if (&webpost($region, $sluser, $slentry) == 1) {
die "Could not post to web\n";
}

# Deletes the message
$pop->delete($msgid);

# Resets some global variables;
$check = 0;
$messtext = '';
}
}

# closes the connection
$pop->quit();
# Waits a minute before posting
sleep(60);
}

#####

# The subroutine that posts to the web
sub webpost {

# local variables
my ($reg, $use, $mes) = @_;
my $yndie = 1;
my $browser = LWP::UserAgent->new();
my ($year, $mon, $day) = &thetime();
my $response = $browser->post($webserver,
[
'region' => $reg,
'user' => $use,
'entry' => $mes,
'date' => "$mon\/$day\/$year",
'path' => 'update',
],
);
my $gotresponse = $response->content;

return ($gotresponse);

}

# gives the time
sub thetime {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdat) = localtime(time);

if ($mday < 10) { $mday = "0$mday"; }
$mon = $mon + 1;
if ($mon < 10) { $mon = "0$mon"; }
$year = $year + 1900;

return($year, $mon, $mday);
}


Here's third part:

CODE

#!/usr/bin/perl -w
# sl.cgi
# by: Andrew Burton - [email]tuglyraisin@aol.com[/email]
# SL: Jarod Godel - Teal 204, 84
#####
# This is the web script that updates the Second Log files.
#####

#####
# modules
use strict;
use CGI;

#####
# global variables
my $page = CGI->new();

# files
my $table = 'slog.txt';
my $tblname = 'names.txt';
my $script = 'sl.cgi';

# web variables
# declaration
my $path = '';
my $reg = '';
my $user = '';
my $entry = '';
my $dat = '';
# assign
if ($page->param('path')) { $path = $page->param('path'); }
else { $path = "list"; }
if ($page->param('region')) { $reg = $page->param('region'); }
if ($page->param('user')) { $user = $page->param('user'); }
if ($page->param('entry')) { $entry = $page->param('entry'); }
if ($page->param('date')) { $dat = $page->param('date'); }

# misc var.
my $topentry = 30;

#####
# Decides what to do
if ($path =~ m/list/i) { &showlist(); }
elsif ($path =~ m/entry/i) { &showentry(); }
elsif ($path =~ m/update/i) { &update(); }

#####
# Exits
exit;

##########

# Shows a list of the entries
sub showlist {

# local variables
my $entnum = 0;

open (SLOG, "$table") || &error_msg("Cannot open $table for reading");
my @entries = <SLOG>;
close (SLOG) || &error_msg("Cannot close $table after reading");

print $page->header(),
$page->start_html(-title => 'Second Log: Main'),
$page->h1('Second Log'),
$page->p;

while ($entries[$entnum]) {
my @linedata = split (/\|/, $entries[$entnum], 4);

my $usurl = $linedata[0];
$usurl =~ s/ /\-/g;

my $url = $script . '?user=' . $usurl . '&path=entry';
print '<p><a href="' . $url . '">' . $linedata[0] . '</a> ',
'posted from ' . $linedata[1] . ' on ' . $linedata[2] . ':<br>',
$linedata[3] . '</p>';

$entnum++;

if ($entnum == $topentry) { last; }
}

print $page->hr(),
$page->p('Users:');

open (GPNA, "$tblname") || &error_log("Could not get name list");
while (my $namez = <GPNA>) {
chomp($namez);
$namez =~ s/ /\-/g;
print "<a href=\"$script?user=$namez\&path=entry\">";
$namez =~ s/\-/ /g;
print "$namez</a> ";
}
close (GPNA) || &error_log("Could not close name list");

print $page->p(),
$page->end_html();
}

# Shows a users entries
sub showentry {

# local variables

$user =~ s/\-/ /g;

print $page->header(),
$page->start_html(-title => "Second Log: $user"),
$page->h1("$user"),
$page->p();

open (GETEN, "$table") || &error_log("Could not open $table for $user entries");
while (my $uline = <GETEN>) {
chomp($uline);
my @udata = split (/\|/, $uline, 4);

if ($udata[0] =~ m/$user/i) {
print '<p><i>From ' . $udata[1] . ' on ' . $udata[2] . ':</i><br>' . $udata[3] . '</p>';
}
}
close (GETEN) || &error_log("Could not close $table after $user entries");

print '<center><a href="' . $script . '?path=list">Second Log</a></center>',
$page->p(),
$page->end_html();
}

# Updates a journal
sub update {

# local variables
my $newname = 1;

# Gets old entries
open (GETBL, "$table") || &error_msg("Cannot open $table for reading");
my @oldentries = <GETBL>;
close (GETBL) || &error_msg("Cannot close $table after reading");

open (PUTBL, ">$table") || &error_msg("Cannot open $table for writing");
print PUTBL $user . '|' . $reg . '|' . $dat . '|' . $entry . "\n";
foreach my $oline (@oldentries) {
print PUTBL $oline;
}
close (PUTBL) || &error_msg("Cannot close $table after writing");

# Gets the names of everyone who has left a message
open (GETNA, "$tblname") || &error_msg("Cannot open $tblname for reading");
my @oldnames = <GETNA>;
close (GETNA) || &error_msg("Cannot close $tblname after reading");

foreach my $oname (@oldnames) {
chomp($oname);
if ($oname =~ m/$user/i) { $newname = 0; }
}

if ($newname == 1) {
open (PUTNA, ">>$tblname") || &error_msg("Cannot open $tblname for writing");
print PUTNA $user . "\n";
close (PUTNA) || &error_msg("Cannot close $tblname after writing");
}

print '1';
}

##########

# Print error messages
sub error_msg {

print $page->header(),
$page->start_html(-title => 'Second Log: Error'),
$page->h1($_[0]),
$page->end_html();

exit;
}
_____________________
"All designers in SL need to be aware of the fact that there are now quite simple methods of complete texture theft in SL that are impossible to stop..." - Cristiano Midnight

Ad aspera per intelligentem prohibitus.
jessip Perkins
Registered User
Join date: 15 Nov 2003
Posts: 7
wholy crap
02-09-2004 22:40
wholy crap
_____________________
I made it physical and the darn thing went through the floor.... no really i cant find it...
Jarod Godel
Utilitarian
Join date: 6 Nov 2003
Posts: 729
02-11-2004 09:14
Do you mean "wholly crap," as in "this is junk," or "holy crap," as in "Jarod Godel, this is amazing; here have a Natalie Portman?"
_____________________
"All designers in SL need to be aware of the fact that there are now quite simple methods of complete texture theft in SL that are impossible to stop..." - Cristiano Midnight

Ad aspera per intelligentem prohibitus.
Khamon Fate
fategardens.net
Join date: 21 Nov 2003
Posts: 4,177
03-23-2005 06:57
bump for people who might be interested
Charlotte Gillespie
2 - 0 Lindens
Join date: 19 Nov 2004
Posts: 1,101
03-25-2005 14:29
The link brings up nothing more than a really crap webcam page and a Microsoft plugin.
Roberta Dalek
Probably trouble
Join date: 21 Oct 2004
Posts: 1,174
03-26-2005 19:17
To be honest Direct Webcam looks like a porn site. I naturally didn't install the plug in it asked me to.
Mustikos Roo
Registered User
Join date: 29 Jan 2005
Posts: 20
yeah, what the heck
03-27-2005 00:27
Ya Man,

What is up with that link? Some porn or something, Jarrod, I think u need to check the WORKING VERSION link in the topic starter
Tony Beckett
dAlliez Island Rentals
Join date: 25 Jun 2004
Posts: 19
the page has a virus
03-27-2005 07:05
When i clicked your link my mcafee caught us1.exe dialer virus - ty very much
Jarod Godel
Utilitarian
Join date: 6 Nov 2003
Posts: 729
03-27-2005 16:04
http://keiichi.straynet.org/cgi-bin/sl.cgi

Sometimes links break. Deal with it.
_____________________
"All designers in SL need to be aware of the fact that there are now quite simple methods of complete texture theft in SL that are impossible to stop..." - Cristiano Midnight

Ad aspera per intelligentem prohibitus.
Etoile Parvenu
She Came from the Stars
Join date: 25 Feb 2005
Posts: 44
03-29-2005 04:37
Looks impressive - I will have to try it out next time I am in-world. I haven't peered at the code too closely as yet, but could it be hooked into an API for publishing to existing sites running blog software?

(Side note: a dialer isn't exactly a virus, it's more its own type of malware as far as I know.)
Walker Spaight
Raving Correspondent
Join date: 2 Jan 2005
Posts: 281
03-29-2005 10:05
I haven't looked at the code yet, but this looks cool, Jarod.

If you like, check out the in-world blogging project (open source) that I've been working on lately, based on Strife Onizuka and Brian Livingston's work.

the thread on it:
/120/d8/39436/1.html

I'll drop a copy of the latest iteration of my code here when I get a chance. Or feel free to pick yourself up a copy of the blogging laptop that's available at my place in Louise (228, 192) on the second floor above ground level.

All we ask is that future mods of the product remain open source.

Have fun!
_____________________
Read The Second Life Herald: All the fairly unbalanced news we see fit to print.

More news and musings at Walkering.com

"Thank you, Walker Spaight, wherever you are!!"
--Trinity Serpentine