Initial commit
This commit is contained in:
Thomas Schwery
commit
eb48e9e8d7
2 changed files with 310 additions and 0 deletions
149
Privileges/Drop.pm
Normal file
149
Privileges/Drop.pm
Normal file
|
|
@ -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 <tlb@rapanden.dk>
|
||||
|
||||
=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;
|
||||
161
gopher.pl
Normal file
161
gopher.pl
Normal file
|
|
@ -0,0 +1,161 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
#####################################
|
||||
# Thomas Schwery <thomas@schwery.me>
|
||||
####################################
|
||||
#
|
||||
# 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 (<FILE>) {
|
||||
$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 (<FILE>) {
|
||||
$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 (<ENTRY>) {
|
||||
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 (<FILE>) {
|
||||
$entry_text .= $_;
|
||||
}
|
||||
$entry_text =~ s/\r?\n/<br>/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;
|
||||
}
|
||||
Reference in a new issue