key1: value
key2: value
key2: value2
#key3: this is a key3 comment
key3: value

##</code><code>##

#include <stdio.h>
#include <unistd.h>
#include <fcntl.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <string.h>

/* path to look for .pl scripts, .conf should be there too */
#define SCRIPT_PATH "/home/ant/scripts:/var/scripts/"

char *find_script(char *);

int main(int argc, char **argv) {
  struct stat caller;
  int fd;
  int euid,uid,loc;
  char script[1024];
  char cmd[4096];
  char key[256];
  char conf[1024];
  char path[10240];
  char *tmp,*tmp2;
  char *scr_path;

  int i = 0;

  /* strip base name */
  if(tmp  = rindex(argv[0], '/')) {
    tmp++;
  } else {
    tmp = argv[0];
  }

  /* remove extension */
  if(tmp2 = index(tmp,'.')) {
    *tmp2 = '\0';
  }

  /* save it */
  strcpy(key, tmp);

  /* find where script with same base name is */
  scr_path = find_script(key);

  /* has path info */
  if(index(argv[0],'/')) {
    lstat(argv[0], &caller);
  } else {
    /* was called from PATH... seek it out and make sure it is legal */
    strcpy(path,(char *)getenv("PATH"));
    tmp = path;
    while(tmp = strtok(tmp,":")) {
      strcpy(cmd,tmp);
      strcat(cmd,"/");
      strcat(cmd,argv[0]);
      if(!lstat(cmd, &caller)) {
        break;
      }
      tmp = NULL;
    }
  }

  euid = geteuid();
  uid  = getuid();

  /* is link owned by suid user or root? */
  if(caller.st_uid != euid && uid != 0) {
    fprintf(stderr, "Invalid attempt to call loader from an unauthorized link, bad user, no biscuit!\n");
    exit(1);
  }


  /* build paths to script and conf */
  sprintf(conf, "%s/%s.conf", scr_path, key);
  sprintf(script, "%s/%s.pl", scr_path, key);

  /* open conf... RW if can, RO if not put on fd
     why 27 and 28? why not? doubt they will be used? */
  fd = open(conf, O_RDWR);
  if(fd >= 0)
    dup2(fd, 27);
  else {
    fd = open(conf, O_RDONLY);
    dup2(fd, 28);
  }

  close(fd);
  /* we don't want to be special any more */
  setuid(getuid());
  seteuid(getuid());
  setgid(getgid());
  setegid(getgid());

  /* become the perl script */
  execvp(script,NULL);
}

char *find_script(char *key)
{
    char *tmp;
    char path[4096];
    char cmd[1024];
    struct stat script;

    strcpy(path, SCRIPT_PATH);
    tmp = path;

    while(tmp = strtok(tmp,":")) {
      strcpy(cmd,tmp);
      strcat(cmd,"/");
      strcat(cmd,key);
      strcat(cmd,".pl");
      if(!lstat(cmd, &script)) {
        break;
      }
      tmp = NULL;
    }
    return tmp;
}

##</code><code>##

#!/usr/bin/perl
package loader;
use Fcntl;
use strict;
use vars qw(@EXPORT_OK);
@EXPORT_OK = qw(get_conf write_conf);
#F_SETFD w/ fcntl() and $^F

# This routine opens the file, then memoizes itself
sub _open {
    local $^W = 0;
    my($fh,$type);
    if(open $fh, "+<&=27") {
        $type = 1;
    } elsif(open $fh, "<&=28") {
        $type = 0;
    } else {
        *_open = sub {};
        warn "No conf file available: $!";
        return;
    }
    fcntl($fh, F_GETFL, $_);
    *_open = sub {
        return($fh,$type);
    };
    _open();
}

# read conf and make it a data structure
sub get_conf {
    my ($fh,$type) = _open();
    my (%conf,%loader_comments);
    unless($fh) {
        warn("get_conf failed... no filehandle");
        return;
    }
    local $_;
    while(<$fh>) {
        my($k,$v);
        next if /^\s+\#/;
        chomp;
        if(/^\#\s*(?:([^:]+):)?/) {
            push @{$loader_comments{$1}}, $_;
        } elsif((($k,$v) = split /:\s*/, $_, 2) == 2) {
            if($conf{$k}) {
                if(ref $conf{$k}) {
                    push @{$conf{$k}}, $v;
                } else {
                    $conf{$k} = [$conf{$k}, $v];
                }
            } else {
                $conf{$k} = $v;
            }
        }
    }
    # save the comments for the nice people
    *_comments = sub {
        \%loader_comments;
    };

    return wantarray ? %conf : \%conf;
}

# write conf data back to file, if it is writeable
sub write_conf {
    my ($fh,$type) = _open();
    unless($type) {
        warn("Conf file not writeable\n");
        return;
    }
    my %conf;
    if(@_ == 1) {
        if(ref $_[0] eq 'HASH') {
            %conf = %{$_[0]};
        } else {
            warn "Need to pass write_conf a hash or hash ref";
            return;
        }
    } else {
        if(@_ % 2) {
            warn "Odd number of arguments to write_hash. Need to pass write_conf a hash or hash ref";
            return;
        }
        %conf = @_;
    }

    seek($fh, 0, 0);
    my $c = &_comments;
    # write general comments at top
    for my $comment (@{$c->{''}}) {
        print $fh "$comment\n";
    }
    print $fh "\n";
    for my $k (sort keys %conf) {
        $c->{$k}[0] ||= "# $k: ";
        # write comments for indivisual keys
        for my $comment (@{$c->{$k}}) {
            print $fh "$comment\n";
        }
        if(ref $conf{$k}) {
            for my $a (@{$conf{$k}}) {
                print $fh "$k: $a\n";
            }
        } else {
            print $fh "$k: $conf{$k}\n";
        }
        print $fh "\n";
    }
    truncate $fh, tell $fh;
}

# close your file handles!
END {
    my $fh = (_open())[0];
    close $fh if $fh;
}

1;

##</code><code>##

pass: tonkatruck

##</code><code>##

#!/usr/bin/perl -w
use loader;
use strict;

my %conf = &loader::get_conf();
print "Pass is $conf{pass}\n";