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