#!/usr/bin/perl # # SMArT # # Main web frontend # # Copyright 2001 Wilmer van der Gaast (lintux@lintux.cx) # # # 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; $smart_version = '@MARS_NWE_VERSION@'; $server_id = 'Server: SMArT/Perl/' . $smart_version; if( ! do('@MARS_NWE_INSTALL_FULL_CONFDIR@/smart.conf') ) { die "Could not load @MARS_NWE_INSTALL_FULL_CONFDIR@/smart.conf: $@ $!"; } $ENV{HOME} = '@MARS_NWE_INSTALL_FULL_CONFDIR@'; $smart_libexec_dir = '@MARS_NWE_INSTALL_FULL_LIBEXECDIR@'; $smart_libexec_dir =~ s#/*$##; close( STDERR ); open( STDERR, '>>' . $smart_log_path ) or die "Could not open $smart_log_path: $!"; select( STDERR ); $| = 1; select( STDOUT ); $| = 1; sub log_timestamp() { my @t = localtime( time() ); return sprintf( '%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0] ); } sub log_msg( $$ ) { my( $level, $msg ) = @_; print STDERR '[' . log_timestamp() . '] [' . $level . '] [SMArT ' . $smart_version . '] ' . $msg . "\n"; } sub log_info( $ ) { log_msg( 'INFO', $_[0] ); } sub log_error( $ ) { log_msg( 'ERROR', $_[0] ); } log_info( 'starting' ); log_info( 'loaded configuration from ' . '@MARS_NWE_INSTALL_FULL_CONFDIR@/smart.conf' ); $l = ; if( ! defined( $l ) ) { log_error( 'no request line received on stdin' ); exit( 1 ); } $l =~ s/[\n\r]//g; log_info( 'request: ' . $l ); @c = split( ' ', $l ); $cc = $c[1]; @c = split( '/', $c[1] ); shift( @c ); sub error( $ ) { my( $e ) = @_; log_error( 'HTTP error ' . $e . ' for request ' . $cc ); print <

Error $e

EOF exit; } sub redirect( $ ) { my( $u ) = @_; print < == 0 ) { my $uid = getpwnam( $nonroot_user ); if( ! defined( $uid ) ) { log_error( 'could not resolve non-root user ' . $nonroot_user ); error( 500 ); } $> = $uid; } } sub get_server() { open( SFILE, '<' . $smart_nwclient_path ) or do { log_error( 'could not open ' . $smart_nwclient_path . ': ' . $! ); return ''; }; chomp( $line = ); close( SFILE ); $line =~ s/\/.*//; return( $line ); } sub get_bindery_password() { open( SFILE, '<' . $smart_nwclient_path ) or do { log_error( 'could not open ' . $smart_nwclient_path . ': ' . $! ); return ''; }; chomp( $line = ); close( SFILE ); $line =~ s/.* //; return( $line ); } sub unix_userlist() { my( @l, @r, $u ); open( FILE, ' ) { chomp; @l = split( /:/ ); $u = {}; $u->{name} = $l[0]; $u->{uid} = $l[2]; push( @r, $u ); } close( FILE ); return( @r ); } sub unix_grouplist() { my( @l, @r, $u ); open( FILE, ' ) { chomp; @l = split( /:/ ); $u = {}; $u->{name} = $l[0]; $u->{gid} = $l[2]; push( @r, $u ); } close( FILE ); return( @r ); } sub write_property_string( $$$$$ ) { my( $obj, $type, $prop, $seg, $len, $str ) = @_; open( FILE, '|' . 'nwbpset -S ' . get_server() ) or return; print FILE <; close( FILE ); $s = join( '', @l ); $s =~ s/[\r\n]+$//g; return( $s ); } sub authenticate() { my( @h, $auth, @l, $x ); while( $l = ) { $l =~ s/[\n\r]//g; last if $l eq ''; push( @h, $l ); } ($auth) = grep( /^Authorization: /i, @h ); if( $auth eq '' ) { print <