commit eb48e9e8d793f18541b1e221eb6ef6fbf06c6d14 Author: Thomas Schwery Date: Sat Aug 14 22:34:11 2010 +0200 Initial commit diff --git a/Privileges/Drop.pm b/Privileges/Drop.pm new file mode 100644 index 0000000..45acc61 --- /dev/null +++ b/Privileges/Drop.pm @@ -0,0 +1,149 @@ +package Privileges::Drop; +use strict; +use warnings; +use English; +use Carp; + +our $VERSION = '1.01'; + +=head1 NAME + +Privileges::Drop - A module to make it simple to drop all privileges, even +POSIX groups. + +=head1 DESCRIPTION + +This module tries to simplify the process of dropping privileges. This can be +useful when your Perl program needs to bind to privileged ports, etc. This +module is much like Proc::UID, except that it's implemented in pure Perl. + + +=head1 SYNOPSIS + + use Privileges::Drop; + + # Do privileged stuff + + # Drops privileges and sets euid/uid to 1000 and egid/gid to 1000. + drop_uidgid(1000, 1000); + + # Drop privileges to user nobody looking up gid and uid with getpwname + # This also set the enviroment variables USER, LOGNAME, HOME and SHELL. + drop_privileges('nobody'); + +=head1 METHODS + +=over + +=cut + +use base "Exporter"; + +our @EXPORT = qw(drop_privileges drop_uidgid); + +=item drop_uidgid($uid, $gid, @groups) + +Drops privileges and sets euid/uid to $uid and egid/gid to $gid. + +Supplementary groups can be set in @groups. + +=cut + +sub drop_uidgid { + my ($uid, $gid, @reqPosixGroups) = @_; + + # Sort the groups and make sure they are uniq + my %groupHash = map { $_ => 1 } ($gid, @reqPosixGroups); + my $newgid ="$gid ".join(" ", sort { $a <=> $b } (keys %groupHash)); + + # Drop privileges to $uid and $gid for both effective and save uid/gid + $GID = $EGID = $newgid; + $UID = $EUID = $uid; + + # Sort the output so we can compare it + my %GIDHash = map { $_ => 1 } ($gid, split(/\s/, $GID)); + my $cgid = int($GID)." ".join(" ", sort { $a <=> $b } (keys %GIDHash)); + my %EGIDHash = map { $_ => 1 } ($gid, split(/\s/, $EGID)); + my $cegid = int($EGID)." ".join(" ", sort { $a <=> $b } (keys %EGIDHash)); + + # Check that we did actually drop the privileges + if($UID ne $uid or $EUID ne $uid or $cgid ne $newgid or $cegid ne $newgid) { + croak("Could not drop privileges to uid:$uid, gid:$newgid\n" + ."Currently is: UID:$UID, EUID=$EUID, GID=$cgid, EGID=$cegid\n"); + } +} + +=item drop_privileges($user) + +Drops privileges to the $user, looking up gid and uid with getpwname and +calling drop_uidgid() with these arguments. + +The environment variables USER, LOGNAME, HOME and SHELL are also set to the +values returned by getpwname. + +Returns the $uid and $gid on success and dies on error. + +NOTE: If drop_privileges() is called when you don't have root privileges +it will just return undef; + +=cut + +sub drop_privileges { + my ($user) = @_; + + croak "No user give" if !defined $user; + + # Check if we are root and stop if we are not. + if($UID != 0 and $EUID != 0) { + return; + } + + # Find user in passwd file + my ($uid, $gid, $home, $shell) = (getpwnam($user))[2,3,7,8]; + if(!defined $uid or !defined $gid) { + croak("Could not find uid and gid user $user"); + } + + # Find all the groups the user is a member of + my @groups; + while (my ($name, $comment, $ggid, $mstr) = getgrent()) { + my %membership = map { $_ => 1 } split(/\s/, $mstr); + if(exists $membership{$user}) { + push(@groups, $ggid) if $ggid ne 0; + } + } + + # Cleanup $ENV{} + $ENV{USER} = $user; + $ENV{LOGNAME} = $user; + $ENV{HOME} = $home; + $ENV{SHELL} = $shell; + + drop_uidgid($uid, $gid, @groups); + + return ($uid, $gid, @groups); +} + +=back + +=head1 NOTES + +As this module only uses Perl's build in function, it relies on them to work +correctly. That means setting $GID and $EGID should also call setgroups(), +something that might not have been the case before Perl 5.004. So if you are +running an older version, Proc::UID might be a better choice. + +=head1 AUTHOR + +Troels Liebe Bentsen + +=head1 COPYRIGHT + +Copyright(C) 2007-2009 Troels Liebe Bentsen + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/gopher.pl b/gopher.pl new file mode 100644 index 0000000..a8f51ed --- /dev/null +++ b/gopher.pl @@ -0,0 +1,161 @@ +#!/usr/bin/perl + +##################################### +# Thomas Schwery +#################################### +# +# TODO: +# - Support for a list of tags +# - Cleanup on ctrl-c +# - Multithreading +# - ... + +use strict; +use IO::Socket; +use Fcntl ':mode'; +use Privileges::Drop; +use HTML::Parse; +use HTML::FormatText; +use Text::Wrap; +use Date::Parse; +use Date::Format; + +our $port = 70; +our %entries = (); + +$SIG{INT} = \&signal_handler_interrupt; + +my $socket = new IO::Socket::INET (LocalPort => $port, Proto => 'tcp', Listen => '1'); +die "Unable to open port\n" unless $socket; + +drop_privileges('nobody'); + +while (1) { + my $listen_socket = $socket->accept(); + $_ = <$listen_socket>; + s/\r*\n*//g; + s/\t.*//g; # Don't care about the parameters now ... + my $directory = $_; + print "Client " . $.. ": <" . $_ . ">\n"; + + if (-f $directory) { + if (substr($directory, 0, 4) eq "blog") { + $listen_socket->send(send_blog_entry($directory)); + } else { + open FILE, $directory; + while () { + $listen_socket->send($_); + } + $listen_socket->send("\r\n.\r\n") if (-T $directory); + } + } else { + my $header = generate_header($directory); + my $blog_entries = list_blog_entries(); + + $listen_socket->send($header . "\r\n"); + $listen_socket->send("\r\n"); + $listen_socket->send("i----- Blog entries ---------------\tfake\tfake\t0\r\n"); + $listen_socket->send($blog_entries . "\r\n"); + $listen_socket->send("\r\n.\r\n"); + } +} + +sub generate_header { + my ($directory) = @_; + $directory .= "/" if ($directory); + + return "\r\n" unless (-T $directory . "header"); + + my $message = ""; + open FILE, $directory . "header"; + while () { + $message .= "i" . $_ . "\tfake\tfake\t0\r\n"; + } + close FILE; + $message .= "0About this gopher server\theader\tlocalhost\t" . $port . "\r\n"; + + + return $message; +} + +sub map_content { + my ($dir_entry, $directory) = @_; + $directory .= "/" if ($directory); + my $file_type = -f $directory . $dir_entry ? 0 : 1; + $file_type = 9 if (-f $directory . $dir_entry && -B $directory . $dir_entry); + return $file_type . $dir_entry . "\t" . $directory . $dir_entry . "\tlocalhost\t" . $port; +} + +sub filter_content { + my ($dir_entry, $blog_dir) = @_; + return 1 unless (substr($dir_entry,0,1) eq "." || $dir_entry eq "header"); + return 0; +} + +sub list_blog_entries { + my $blog_dir = "blog"; + unless (opendir(IMD, $blog_dir)) { + die("Fuck you all ..."); + } + my @files = readdir(IMD); + closedir(IMD); + + @files = grep filter_content($_, $blog_dir), @files; + @files = map map_blog_entry($_, $blog_dir), @files; + + @files = sort sort_entry_line($a,$b), @files; + return join("\r\n", @files); +} + +sub sort_entry_line { + my $a_date = $2 if ($a =~ m/^0(\[.*\]\s)?(.*?)\s*-.*$/); + my $b_date = $2 if ($b =~ m/^0(\[.*\]\s)?(.*?)\s*-.*$/); + + return str2time($a_date) <=> str2time($b_date); +} + +sub read_entry_file { + my ($entry_file) = @_; + my $subject = ""; + my $date_file = ""; + my $tags = ""; + + open ENTRY, $entry_file; + while () { + s/\r*\n*//; + $subject = $1 if (m/^Subject:\s*(.*)$/); + $tags = $1 if (m/^Tags:\s*(.*)$/); + $date_file = $1 if (m/^Date:\s*(.*)$/); + } + close ENTRY; + + my $time = str2time($date_file); + my $date = time2str("%o %h %Y", $time); + return "[" . $tags . "] " . $date . " - " . $subject if($tags); + return $date. " - " . $subject; +} + +sub map_blog_entry { + my ($entry_file, $entry_dir) = @_; + my $entry_title = read_entry_file($entry_dir . "/" . $entry_file); + return "0" . $entry_title . "\t" . $entry_dir . "/" . $entry_file . "\tlocalhost\t" . $port; +} + +sub send_blog_entry { + my ($entry_file) = @_; + open FILE, $entry_file; + my $entry_text = ""; + while () { + $entry_text .= $_; + } + $entry_text =~ s/\r?\n/
/mg; + my $plain_text = HTML::FormatText->new->format(parse_html($entry_text)); + $Text::Wrap::columns = 80; + $plain_text = wrap("\t", "", $plain_text); + return $plain_text; +} + +sub signal_handler_interrupt { + print "ctrl-c, exiting...\n"; + exit 0; +}