Files
mars-smart/smart.cmake
2026-04-21 08:34:09 +02:00

313 lines
5.4 KiB
CMake
Executable File

#!/usr/bin/perl
#
# SMArT
#
# Main program file
#
# Copyright 2001 Wilmer van der Gaast
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#
$redirected = 0;
$server_id = 'Server: SMArT/Perl/@MARS_NWE_VERSION@';
do( '@MARS_NWE_INSTALL_FULL_CONFDIR@/smart.conf' )
or die "Could not load @MARS_NWE_INSTALL_FULL_CONFDIR@/smart.conf: $@ $!";
close( STDERR );
open( STDERR, '>>' . $smart_log_path )
or die "Could not open $smart_log_path: $!";
$ENV{HOME} = '@MARS_NWE_INSTALL_FULL_CONFDIR@';
$smart_libexec_dir = '@MARS_NWE_INSTALL_FULL_LIBEXECDIR@';
$smart_libexec_dir =~ s#/*$##;
$l = <STDIN>;
$l =~ s/[\n\r]//g;
@c = split( ' ', $l );
if( scalar( @c ) > 2 )
{
while( keys( %h ) < 15 ) # Who would ever want to send more headers???
{
$l = <STDIN>;
$l =~ s/[\n\r]//g;
if( $l eq '' )
{ last; }
$n = $l;
$n =~ s/:[^:]*$//g;
$v = $l;
$v =~ s/^[^:]*://g;
$h{$n} = $v;
}
}
$c[0] = uc( $c[0] );
if( $h{Authorization} eq '' )
{ error( 401 ); }
else
{
@s = split( ' ', $h{Authorization} );
if( $s[0] ne 'Basic' or length( $h{Authorization} ) > 80 ) # We can't be too careful, can we...
{ error( 401 ); }
else
{
$s[1] =~ tr#A-Za-z0-9+/##cd;
$s[1] =~ tr#A-Za-z0-9+/# -_#;
$s[1] = pack( 'c', 32 + 0.75 * length( $s[1] ) ) . $s[1];
$s[1] = unpack( 'u', $s[1] );
$s[1] =~ s/[\r\n]//g;
@l = split( ':', $s[1] );
if( $l[0] ne 'root' )
{ error( 401 ); }
else
{ if( $x = system( $smart_check_login, @l ) )
{ error( 401 ); } }
}
}
if( $c[0] ne 'GET' )
{
error( 501 );
}
@p = split( '\?', $c[1] );
$cc = $c[1];
$cc =~ s/[^\?]*\?//;
$c = substr( shift( @p ), 1 );
@p = split( '&', $p[0] );
foreach $p ( @p )
{
$n = $p;
$n =~ s/=.*//;
$v = $p;
$v =~ s/.*=//;
$v =~ s/\+/ /g;
$v =~ s/%([0-9A-F][0-9A-F])/pack('c',hex($1))/gie;
$p{$n} = $v;
}
@c = split( '/', $c );
if( $c[0] eq 'apply' )
{
do( $smart_libexec_dir . '/readconfig.pl' );
do( $smart_libexec_dir . '/apply.pl' );
handle_request();
exit;
}
elsif( $c[0] eq 'settings' )
{
do( $smart_libexec_dir . '/readconfig.pl' );
}
drop_root();
if( $c[0] eq '' )
{
print <<EOF;
HTTP/1.0 200 OK
Content-Type: text/html
$server_id
<HTML>
<HEAD>
<TITLE>SMArT</TITLE>
</HEAD>
<FRAMESET COLS="50%,50%">
<FRAME NAME="MENU" SRC="/static/menu.html">
<FRAME NAME="OPTS" SRC="/static/start.html">
</FRAMESET>
</HTML>
EOF
exit;
}
elsif( $c[0] eq 'static' )
{
do( $smart_libexec_dir . '/static.pl' );
}
elsif( $c[0] eq 'settings' )
{
do( $smart_libexec_dir . '/settings.pl' );
}
else
{
error( 500 );
}
handle_request();
exit;
##########################################
##### END OF MAIN PROCEDURES FOLLOW #####
##########################################
sub error( $ )
{
if( $_[0] eq '401' )
{
print <<EOF;
HTTP/1.0 401 Access denied
Content-Type: text/plain
WWW-Authenticate: Basic realm="SMArT"
$server_id
You're not allowed to access this URL.
EOF
}
elsif( $_[0] eq '404' )
{
print <<EOF;
HTTP/1.0 404 File not found
Content-Type: text/plain
$server_id
The file you requested does not exist.
EOF
}
elsif( $_[0] eq '501' )
{
print <<EOF;
HTTP/1.0 501 Unknown command
Content-Type: text/plain
$server_id
Unknown command: $c[0]
EOF
}
else
{
print <<EOF;
HTTP/1.0 500 Internal server error
Content-Type: text/plain
$server_id
Something went wrong...
EOF
}
exit;
}
sub unix_userlist()
{
my( @c, @d, %e );
while( @d = getpwent )
{
unshift( @c, { name => $d[0], uid => $d[2] } );
}
return( sort( { $a->{"name"} cmp $b->{"name"} } @c ) );
}
sub unix_grouplist()
{
my( @c, @d, %e );
while( @d = getgrent )
{
unshift( @c, { name => $d[0], gid => $d[2] } );
}
return( sort( { $a->{"name"} cmp $b->{"name"} } @c ) );
}
sub redirect( $ )
{
if( $redirected != 0 )
{ return( 0 ); }
$redirected = 1;
print <<EOF;
HTTP/1.0 302 Page relocated
Content-Type: text/plain
Location: $_[0]
$server_id
EOF
}
sub get_server
{
open( SFILE, '<' . $smart_nwclient_path );
chomp( $line = <SFILE> );
close( SFILE );
$line =~ s/\/.*//;
return( $line );
}
sub get_bindery_password
{
open( SFILE, '<' . $smart_nwclient_path );
chomp( $line = <SFILE> );
close( SFILE );
$line =~ s/.* //;
return( $line );
}
sub read_property_string
{
my @x = split( "\n", `nwbpvalues -c -o $_[0] -t $_[1] -p $_[2] -S $server` );
my( $i, $s );
$i = 5;
while( hex( $x[$i] ) > 0 )
{
$s .= pack( 'c', hex( $x[$i] ) );
$i ++;
}
return( $s );
}
sub read_property_list
{
my @x = split( "\n", `nwbpvalues -c -o $_[0] -t $_[1] -p $_[2] -S $server` );
my( $i, @l );
$i = 6;
while( $x[$i] ne '' )
{
unshift( @l, $x[$i] );
$i += 2;
}
return( @l );
}
sub write_property_string
{
open( FILE, '|' . 'nwbpset -S ' . $server );
print FILE <<EOF;
000$_[1]
$_[0]
$_[2]
$_[3]
$_[4]
EOF
for $i ( 0 .. length( $_[5] ) - 1 )
{
print( FILE unpack( 'H2', substr( $_[5], $i, 1 ) ) . "\n" );
}
close( FILE );
}
sub drop_root
{
$< = $> = getpwnam( $nonroot_user );
}