SMOLNET PORTAL home about changes
#!/usr/pkg/bin/perl -w
#
# slerm - SLugmax's gERM
# Based on germ - let your ideas germinate (c) 2009, Wesley Teal,
# wt@sdf.lonestar.org
# Modifications 2009-2017 by slugmax@sdf.org
#
# distributed under the MIT/X Consortium License, see LICENSE for details
#
# $Id: slerm.cgi,v 1.8 2017/05/08 13:36:26 slugmax Exp $
#
use strict;
use Text::Wrap;
$Text::Wrap::columns=68;
use Fcntl qw(:flock);
use POSIX qw(strftime);
use File::Basename;
use Mail::Mailer;
use English;

# Nix the PATH and prevent SETUID/SETGID
$ENV{PATH} = "";
$EUID = $UID;
$EGID = $GID;

# === Configurable Variables ===

# this script's name
my $name = "cgi-bin/slerm";

# the server that is hosting the script
my $server = "sdf.org";

# the port number the server uses
my $port = 70;

# the directory used in gopher links, make sure not to end with a "/"
my $base_dir ="/users/USERNAME";

# full path name to the directory you store your *.post, header.txt, and div.txt
# files in, make sure not to end with a "/"

my $dir = "/ftp/pub$base_dir/dat";

# the maximum number of posts you want displayed per phlog page

my $max_posts = 10;

# Whether or not to send an email with any comments (0 means no email)

my $EMAIL_COMMENTS = 1;

# Email to send post comments to

my $comment_email = q{USERNAME@sdf.org};

# If set to 1, post comments in reverse chronological order.

my $COMMENT_ORDER_REVERSE = 0;

# File extension for posts. Comment files will start with this
# extension, with '.cmt' added to the end

my $post_ext = "post";

# Permalink text. Shown as a link on shortened posts or archive pages
my $permalink_text = "View Post or Comment... (NN)";

# List of books you're reading
my $bookshelf = "$dir/bookshelf.txt";

# === End Configurable Variables ===

my $serv_string = "\tnull\ttext\t70";
my $ver = '$Id: slerm.cgi,v 1.8 2017/05/08 13:36:26 slugmax Exp $';
my $header = "$dir/header.txt";
my $div = "$dir/div.txt";
#my $footer = "i$serv_string\r\nipowered by $ver\r\n";
my $footer = "$dir/footer.txt";
my @archive;
my @posts = <$dir/*.$post_ext>;
my @sorted_posts = sort { -M $a <=> -M $b } @posts;
my @sorted_copy = @sorted_posts;

if ($#sorted_posts > $max_posts - 1) {

    until ($#sorted_posts == $max_posts - 1) {

        unshift @archive, pop @sorted_posts;

    }

}

sub num_comments {
    my $comment_file = shift;
    my $cnt = 0;

    $comment_file .= q{.cmt};
    open (my $fh, "<", "$dir/$comment_file") || return 0;

    while (<$fh>) {

        $cnt++ if ( /---/ );

    }

    close ($fh);
    return $cnt
}

sub email_comment {
    my ($recipient,$body) = @_;

    my $from = $recipient;
    my $subject = "New Comment Posted to Your Phlog!";
    my $mailer = Mail::Mailer->new("sendmail");
    $mailer->open({ From    => $from,
		    To      => $recipient,
		    Subject => $subject,
		  })
	or return;
    print $mailer $body or return;
    $mailer->close( );
}

sub nav_links {
    my $phlog_string = "\t$base_dir/$name\t$server\t$port";
    my $main_string = "\t$base_dir\t$server\t$port";

    print "i$serv_string\r\n";
    print "1Back to Phlog Index$phlog_string\r\n";
    print "1Back to The Cave$main_string\r\n";
}

sub filedate {
    my $file = shift;

    return strftime( "%A, %B %d, %Y at %R", localtime((stat ($file))[9]));
}

# Returns true if the given file has the given tag in its #Tags.. line
sub has_tag {
    my $file = shift;
    my $tag = shift;
    my $found = 0;

    open (my $fh, "<", "$file") || return 0;

    while (<$fh>) {

        next if ( !/^#tags/i );
        last if ( $INPUT_LINE_NUMBER > 2 );

        if ( /\b$tag\b/i ) {

            $found = 1;
            last;

        }

    }

    close ($fh);
    return $found;
}

# Prints the lines in the given file as inline-text. Parses tags and
# shortens posts if appropriate
sub printlines {
    my $args = shift;
    my $file = $$args{file};
    my $die_on_error = $$args{die_on_error};
    my $show_tags = $$args{show_tags};
    my $shorten_post = $$args{shorten_post};
    my $fh;

    if ( $die_on_error ) {

      open ($fh, "<", "$file") || die "3Unable to open $file: $!$serv_string\r\n";

    } else {

      open ($fh, "<", "$file") || return;

    }

    while (<$fh>) {

        chomp;
	my $tmpline = $_;

        if ( $show_tags && $tmpline =~ /^#tags/i ) {

            my $tagline = $_;
            $tagline =~ s/^#tags\s+//i;
            $tagline =~ s/\s*,\s*/,/g;
            my @tags = split(/,/,$tagline);
            print "iTags:$serv_string\r\n";

            foreach my $tag ( @tags ) {

                print "1$tag\t$base_dir/$name?tag-$tag\t$server\t$port\r\n";

            }

        }

	# If we detect a gophermap-style link, just print it
	if ( $tmpline =~ /^[\dceghisIMT].+?\t/ ) {

	    print "$tmpline\r\n";

	} else {

	    print "i$tmpline$serv_string\r\n" unless ( $tmpline =~ /^#tags/i || $tmpline =~ /--more--/i );

	}

        last if ( $shorten_post && $tmpline =~ /--more--/i );
    }

    close ($fh);
}

my $query;

if (exists $ENV{QUERY_STRING}) {
    $query = $ENV{QUERY_STRING};
} else {
    $query = join(' ',@ARGV);
}

# Show an individual post or comment. Any tags and the entire
# post/comment are always shown
if ( $query =~ /^(.+\.$post_ext)$/ ) { # show individual posts/comments

    my $go_string = "\t$base_dir/$name?$query\t$server\t$port";
    my $com_string = "\t$base_dir/$name\t$server\t$port";
    my $cmt = "$query.cmt";

    printlines({ file => $header, die_on_error => 0, show_tags => 0 });
    printlines({ file => $div, die_on_error => 0, show_tags => 0 });
    print "1Back to Phlog Index$com_string\r\n";
    print "i$serv_string\r\n";
    printlines({ file => "$dir/$query", die_on_error => 1, show_tags => 1 });
    print "i$serv_string\r\n";
    print "7Leave Comment$com_string\r\n";
    $Text::Wrap::separator = "$serv_string\r\n";
    print wrap("i", "i", "TO LEAVE A COMMENT enter \"$query\" at the prompt followed by a space and then your comment of 250 words or less."), "$serv_string\r\n";
    $Text::Wrap::separator = "\r\n";

    printlines({ file => $div, die_on_error => 0, show_tags => 0 });

    if (-e "$dir/$cmt") {
        printlines({ file => "$dir/$cmt", die_on_error => 1, show_tags => 0 });
    }

    nav_links();
    printlines({ file => $footer, die_on_error => 0, show_tags => 0 });

    exit;

# Show an archive page. Each archive page will have $max_posts posts,
# with a link to the next, previous (if appropriate) and main pages at
# the bottom
} elsif ( $query =~ /^archive(\d+)$/ ) {

    my $num = $1;
    my $min = $max_posts * $num - $max_posts;
    my $max = $max_posts * $num - 1;

    $max = $#archive if ($max > $#archive);

    printlines({ file => $header, die_on_error => 0, show_tags => 0 });
    printlines({ file => $div, die_on_error => 0, show_tags => 0 });

    foreach (@archive[$min .. $max]) {

        my $p_name = basename $_;
        my $go_string = "\t$base_dir/$name?$p_name\t$server\t$port";
        print "i",filedate($_),"$serv_string\r\n";
        print "i$serv_string\r\n";

        printlines({ file => $_, die_on_error => 1, show_tags => 0, shorten_post => 1 });
	my $tmp = $permalink_text;
	$tmp =~ s/NN/num_comments($p_name)/e;
        print "1$tmp$go_string\r\n";
        printlines({ file => $div, die_on_error => 0, show_tags => 0 });

    }

    if ($#archive > $max) {

        my $next_page = $num + 1;
        print "1Older Posts\t$base_dir/$name?archive$next_page\t$server\t$port\r\n";

    }

    if ($num > 1) {

        my $prev_page = $num - 1;
        print "1Newer Posts\t$base_dir/$name?archive$prev_page\t$server\t$port\r\n";

    }

    my $com_string = "\t$base_dir/$name\t$server\t$port";
    print "1Back to Phlog Index$com_string\r\n";

    nav_links();
    printlines({ file => $footer, die_on_error => 0, show_tags => 0 });
    exit;

# Tag support - given a tag, lists all posts containing that tag
} elsif ( $query =~ /^tag-(\w+)$/ ) {

    my $tag = $1;
    my $found = 0;

    printlines({ file => $header, die_on_error => 0, show_tags => 0 });
    printlines({ file => $div, die_on_error => 0, show_tags => 0 });
    foreach my $post (@sorted_copy) {
        next if ( !has_tag($post,$tag) );

        my $p_name = basename $post;
        my $go_string = "\t$base_dir/$name?$p_name\t$server\t$port";
        $found = 1;
        print "i",filedate($post),"$serv_string\r\n";
        print "i$serv_string\r\n";
        printlines({ file => $post, die_on_error => 1, show_tags => 0, shorten_post => 1 });
	my $tmp = $permalink_text;
	$tmp =~ s/NN/num_comments($p_name)/e;
        print "1$tmp$go_string\r\n";
        printlines({ file => $div, die_on_error => 0, show_tags => 0 });
    }

    print "iNo posts found matching the tag \"$tag\"$serv_string\r\n" if ( !$found );

    nav_links();
    printlines({ file => $footer, die_on_error => 0, show_tags => 0 });

    exit;

# Comments - one file per post is reserved for comments, new comments
# are added to a comment file if it already exists
} elsif ($query =~ /^(.+\.$post_ext)\s+([\w\s[:punct:]]+)$/ && length($query) < 950) {

    my $post = $1;
    my $comment_string = $2;

    if ( ! -e "$dir/$post" ) {

        print "3Sorry, we could not find the post '$dir/$post'. Please enter the name of the post you wish to comment on, followed by a space and the comment.$serv_string\r\n";
	nav_links();
	printlines({ file => $footer, die_on_error => 0, show_tags => 0 });
	exit;

    }

    my $comfile = "$dir/$post.cmt";
    my $tmp = "$comfile.tmp";
    my $go_string = "\t$base_dir/$name?$post\t$server\t$port";

    open (my $new, ">", "$tmp");
    flock ($new, LOCK_EX);
    $comment_string = wrap("", "",$comment_string);
    email_comment($comment_email,qq{$post:\n\n$comment_string}) if $EMAIL_COMMENTS;

    if ( $COMMENT_ORDER_REVERSE ) {
        print $new filedate($tmp),"\n";
        print $new $comment_string,"\n";
        print $new "\n---\n";
    }

    if (-e $comfile) {

        open (my $old, "<", "$comfile");
        flock ($old, LOCK_EX);

        while (my $line = <$old>) {

            print $new $line;

        }

        close $old;

    }

    if ( !$COMMENT_ORDER_REVERSE ) {
        print $new "\n---\n";
        print $new filedate($tmp),"\n";
        print $new $comment_string,"\n";
    }

    close $new;
    rename ($tmp, $comfile) || die "3Error trying to rename $tmp to $comfile: $!\r\n";
    chmod 0644, $comfile;
    print "iYour comment has been posted.$serv_string\r\n";
    print "1View your comment$go_string\r\n";

    nav_links();
    printlines({ file => $footer, die_on_error => 0, show_tags => 0 });
    exit;

} elsif ($query =~ /(.+\.$post_ext)\s+[\w[:punct:]]+/ && length($query) >= 950) {

    print "3Sorry, comment should be less than 950 characters$serv_string";

    nav_links();
    printlines({ file => $footer, die_on_error => 0, show_tags => 0 });
    exit;
}

# Main index view - this is what users see initially. No tags are
# shown, and post shortening is enabled
printlines({ file => $header, die_on_error => 0, show_tags => 0 });
printlines({ file => $div, die_on_error => 0, show_tags => 0 });

if ( -e $bookshelf ) {
    printlines({ file => $bookshelf, die_on_error => 0, show_tags => 0 });
    printlines({ file => $div, die_on_error => 0, show_tags => 0 });
}

foreach (@sorted_posts) {

    my $p_name = basename $_;
    my $go_string = "\t$base_dir/$name?$p_name\t$server\t$port";
    print "i",filedate($_),"$serv_string\r\n";
    print "i$serv_string\r\n";
    printlines({ file => $_, die_on_error => 1, show_tags => 0, shorten_post => 1 });
    my $tmp = $permalink_text;
    $tmp =~ s/NN/num_comments($p_name)/e;
    print "1$tmp$go_string\r\n";
    printlines({ file => $div, die_on_error => 0, show_tags => 0 });
}

# Print link to older posts (next page of archives) if needed
if ($#archive >= 0) {

    print "1Older Posts\t$base_dir/$name?archive1\t$server\t$port\r\n";

}

nav_links();
printlines({ file => $footer, die_on_error => 0, show_tags => 0 });
Response: text/plain
Original URLgopher://sdf.org/0/users/slugmax/code/slerm/slerm-1.8.cgi.txt
Content-Typetext/plain; charset=utf-8