#!/usr/local/bin/perl use lib '/usr/local/rib/lib'; # NHSE Repository in a Box (RIB) # # The authors of this software are Paul McMahan and Jeff Horner. # Copyright (c) 1997 by the University of Tennessee. # Permission to use, copy, modify, and distribute this software for any # purpose without fee is hereby granted, provided that this entire notice # is included in all copies of any software which is or includes a copy # or modification of this software and in all copies of the supporting # documentation for such software. # THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED # WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE # MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE # MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE. # # $Id: create_repository.pl,v 1.5 1998/02/11 16:17:46 rib Exp $ # # $Log: create_repository.pl,v $ # Revision 1.5 1998/02/11 16:17:46 rib # removed "#!/usr/local/bin/perl" and "usr lib '/home/rib/rib/lib'" from # top of file # # Revision 1.4 1998/01/22 02:50:09 rib # added the upload and mirroring feature to RIB. This required # the addition of several new scripts and the modification of # admin_repository. # # also, removed any use of # from the RIB scripts because this was working out very # well. # # Revision 1.3 1997/12/10 16:40:17 rib # more mods # # Revision 1.2 1997/12/10 16:34:47 rib # more mods because of change of cvs repository # # Revision 1.1.1.1 1997/12/10 15:59:31 jhorner # RIB pre 1.0 # # Revision 1.3 1997/05/26 17:51:02 jhorner # Took out reference to directory .. # # Revision 1.2 1997/05/26 13:46:43 mcmahan # added admin/ to the references to the paths which go through the cgi-bin/ # directory - this is to fix the problem with access control where the # searching scripts were accidentally access controlled # # Revision 1.1 1997/05/06 18:19:40 jhorner # Initial revision # use File::Copy; use RIB::Util; use RIB::ConfigParser; my $util = RIB::Util->new(); my %in = RIB::Util->ReadParse(); $| = 1; umask 002; $util->PrintHeader(); $RIBDIR = $util->GetRibDir(); $RIBURL = $util->GetRibUrl(); $back_to_top = $util->BackToTop(); $form = "\n"; sub wipe_dirs { return unless @_; my $dir; print "

Removing directories...

removed $dir\n"; } else { print "
couldn't remove $dir : $!\n"; } } print "

\n"; } sub wipe_files { return unless @_; my $file; print "

Removing files...

removed $file\n"; } else { print "
couldn't remove $file : $!\n"; } } print "

\n"; } if ($in{repository}) { $in{contact} =~ s/\s//i; unless ($in{contact}) { print "Submission Error\n"; print "

Submission Error

\n"; print "A contact email address was not specified in the form.\n"; print "Please enter an email address in the\n"; print "appropriate input box, and then try your submission again.\n"; print $form; print $back_to_top; print "\n"; exit; } # do this first! (because of error messaging system) my $config = RIB::ConfigParser->new(); $config->load_config($util->GetRibDir()."/conf/FullBIDM.conf", 1); @classes = $config->Classes(); if ($in{repository}!~/^[A-Za-z0-9\-_]+$/) { print "Submission Error\n"; print "

Submission Error

\n"; print "The repository name should contain only "; print "alphanumeric (0-9, A-Z, a-z),\n"; print "dash (-), and underscore ( _ ) characters and should not \n"; print "contain any spaces.

\n"; print $form; print $back_to_top; print "\n"; exit; } if (-d "$RIBDIR/repositories/$in{repository}") { print "Submission Error\n"; print "

Submission Error

\n"; print "The directory name \"$in{repository}\" "; print "already exists in $RIBDIR/repositories.

\n"; print "Please use a different name for the repository.
\n"; print $form; print $back_to_top; print "\n"; exit; } print "Repository Creation Results\n"; print "\n"; print "

Repository Creation Results

\n"; print "As the new repository is created you will see the output "; print "from each action that this process attempts to take.\n"; print "If everything goes smoothly then you will see the word\n"; print ""Success" in large bold letters at the bottom of\n"; print "this page and further instructions.\n"; print "

If an error occurs then an explanation of why the\n"; print "error occurred will be provided. You might be able to fix\n"; print "the error by changing the permissions on a file or a directory\n"; print "somewhere in your RIB installation directory ($RIBDIR).\n"; print "However, the problem might be more serious and require\n"; print "intervention by your local RIB guru or system administrator.\n"; print "

\n"; print "

Creating directory $RIBDIR/repositories/$in{repository}... \n"; if (!(mkdir("$RIBDIR/repositories/$in{repository}",0775))) { print "

\n"; print "

Error

\n"; print "Couldn't make a directory called "; print "$RIBDIR/repositories/$in{repository} .

\n"; print "

Reason: $!

"; print "To correct this error you need to make sure that the directory\n"; print "$RIBDIR/repositories is writable by your http server's user, "; print """, $util->GetUserName(), "".

\n"; print "Once you've corrected this problem you can click\n"; print ""; print "here to try once again to create the new repository.\n"; print $back_to_top; print "\n"; exit; } unshift (@made_dirs, "$RIBDIR/repositories/$in{repository}"); print "done.\n"; foreach $dir ('catalog', 'conf', 'objects', 'index', 'files') { print "

Creating directory $RIBDIR/repositories/$in{repository}/$dir...\n"; if (!(mkdir("$RIBDIR/repositories/$in{repository}/$dir",0775))) { print "\n"; print "

Error

\n"; print "Couldn't make new "$dir" directory in "; print "$RIBDIR/repositories/$in{repository}.

\n"; print "

Reason: $!

"; print "It is unclear what might have caused this problem since the\n"; print "directory in which this directory was to be created was just\n"; print "now made with permissions set properly. The problem might\n"; print "have been caused by someone modifying your RIB software.\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } unshift (@made_dirs, "$RIBDIR/repositories/$in{repository}/$dir"); print "done.\n"; } print "

Creating directory $RIBDIR/cgi-bin/admin/repositories/$in{repository}...\n"; if (!(mkdir("$RIBDIR/cgi-bin/admin/repositories/$in{repository}",0775))) { print "\n"; print "

Error

\n"; print "Couldn't make new "$dir" directory "; print "$RIBDIR/cgi-bin/admin/repositories.

\n"; print "

Reason: $!

"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } unshift (@made_dirs, "$RIBDIR/cgi-bin/admin/repositories/$in{repository}"); print "done.\n"; print "

Checking $RIBDIR/conf/FullBIDM.conf for default class names...\n"; if (! -e "$RIBDIR/conf/FullBIDM.conf") { print "\n"; print "

Error

\n"; print "$RIBDIR/conf/FullBIDM.conf does not exist in your RIB installation.\n"; print "This file must exist for new repositories to be created.\n"; print "If you cannot find a copy of this file then you might need \n"; print "to use the FullBIDM.conf file that was packaged with your RIB\n"; print "software when you first unpacked it.\n"; print "

After this problem has been taken care of click\n"; print "here\n"; print "to make another attempt at creating the new repository.\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; print "\n"; exit; } if (!open (CONF, "<$RIBDIR/conf/FullBIDM.conf")) { print "\n"; print "

Error

\n"; print "Couldn't open the default FullBIDM.conf file at "; print "$RIBDIR/conf/FullBIDM.conf .\n"; print "

Reason: $!

\n"; print "To correct this error you need to make sure that the file\n"; print "$RIBDIR/conf/FullBIDM.conf is readable by your http server's "; print "username, "", $util->GetUserName(), "".

"; print "Once you've corrected this problem you can click\n"; print ""; print "here to try once again to create the new repository.

\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; print "\n"; exit; } close (CONF); if (!(@classes)) { print "\n"; print "

Error

\n"; print "Couldn't extract the default class names from "; print "$RIBDIR/conf/FullBIDM.conf.

Reason: the file is either not in\n"; print "proper format or does not contain any class descriptions.

\n"; print "To fix this problem you need to look at\n"; print "$RIBDIR/conf/FullBIDM.conf and make sure that it is in the\n"; print "proper format.\n"; print "The file is not in the proper format if it is empty or doesn't\n"; print "conform to the strict syntax for a FullBIDM.conf file (see RIB\n"; print "documentation for syntax).\n"; print "If it is not in the proper format and you are unable to repair\n"; print "the file then you might have "; print "to use the copy of FullBIDM.conf that\n"; print "was bundled with your RIB software when you first unpacked it.\n"; print "

If you correct the FullBIDM.conf then you can\n"; print "click "; print "here after it has been corrected to attempt to create the\n"; print "repository again.\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "done.\n"; print "

Making a directory for each default class name...\n"; print "

Creating directory "; print "$RIBDIR/repositories/$in{repository}/objects/$class...\n"; if (!(mkdir("$RIBDIR/repositories/$in{repository}/objects/$class",0775))) { print "

\n"; print "

Error

\n"; print "Couldn't make a $class directory in "; print "$RIBDIR/repositories/$in{repository}/objects.

\n"; print "

Reason: $!

\n"; print "It is unclear what might have caused this problem since the\n"; print "directory in which this directory was to be created was just\n"; print "now made with permissions set properly. The problem might\n"; print "have been caused by someone modifying your RIB software.\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "done.\n"; unshift (@made_dirs,"$RIBDIR/repositories/$in{repository}/objects/$class"); # Directories under catalog print "

Creating directory "; print "$RIBDIR/repositories/$in{repository}/catalog/$class...\n"; if (!(mkdir("$RIBDIR/repositories/$in{repository}/catalog/$class",0775))) { print "\n"; print "

Error

\n"; print "Couldn't make a $class directory in "; print "$RIBDIR/repositories/$in{repository}/catalog.

\n"; print "

Reason: $!

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "done.\n"; unshift (@made_dirs,"$RIBDIR/repositories/$in{repository}/catalog/$class"); } print "\n"; #foreach $dir ("$RIBDIR/conf", "$RIBDIR/cgi-scripts") { foreach $dir ("$RIBDIR/cgi-scripts") { print "

Checking $dir for files to copy into the new\n"; print "repository's cgi directory ...\n"; print "

\n"; if (!opendir (DIR, "$dir")) { print "\n"; print "\n"; print "

Error

\n"; print "Couldn't open the $dir directory.

\n"; print "

Reason: $!

"; print "To correct this error you need to make sure that the directory\n"; print "$dir is readable by your http server's "; print "username, "", $util->GetUserName(), "".

"; print "Once you've corrected this problem you can click\n"; print ""; print "here to try once again to create the new repository.

\n"; print "

Cleaning up...
\n"; &wipe_dirs(@made_dirs); print $back_to_top; exit; } foreach $file (readdir(DIR)) { next unless -f "$dir/$file"; if ($dir eq "$RIBDIR/cgi-scripts") { $newfile = "$RIBDIR/cgi-bin/admin/repositories/$in{repository}/$file"; $filemode = 0755; } elsif ($dir eq "$RIBDIR/conf") { $newfile = "$RIBDIR/repositories/$in{repository}/conf/$file"; $filemode = 0644; } else { print "\n"; print "\n"; print "

Error

\n"; print "unknown directory : $dir "; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "

Copying $dir/$file to $newfile... \n"; if (!(copy("$dir/$file",$newfile))) { print "\n"; print "\n"; print "

Error

\n"; print "Couldn't copy $dir/$file "; print "to $newfile.\n"; print "

Reason : $!\n"; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "done.\n"; push (@new_files, $newfile); my $chmoderror=0; print "
setting file permissions... "; unless (chmod $filemode, $newfile) { print "\n"; print "

Error

\n"; print "Couldn't chmod "; print "$newfile to $filemode.\n"; print "

Reason : $!\n"; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } print "done.\n"; } print "\n"; closedir(DIR); } unless (-f "$RIBDIR/conf/Simple.conf") { print "\n"; print "

Error

\n"; print "Couldn't find $RIBDIR/conf/Simple.conf. This file is the "; print "default configuration file for newly created repositories. "; print "Until this critical file is replaced in the directory "; print "$RIBDIR/conf no new repositories can be created.\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } unless (copy("$RIBDIR/conf/Simple.conf","$RIBDIR/repositories/$in{repository}/conf/BIDM.conf")) { print "\n"; print "

Error

\n"; print "Couldn't copy $RIBDIR/conf/Simple.conf to "; print "$RIBDIR/repositories/$in{repository}/conf/BIDM.conf.\n"; print "

Reason : $!\n"; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } unshift(@new_files,"$RIBDIR/repositories/$in{repository}/conf/BIDM.conf"); unless (copy("$RIBDIR/conf/NHSEdomains.html","$RIBDIR/repositories/$in{repository}/conf/domains.html")) { print "\n"; print "

Error

\n"; print "Couldn't copy $RIBDIR/conf/NHSEdomains.html to "; print "$RIBDIR/repositories/$in{repository}/conf/domains.html.\n"; print "

Reason : $!\n"; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } unshift(@new_files,"$RIBDIR/repositories/$in{repository}/conf/domains.html"); umask (002); print "

Creating default header and footer files:\n"; print "

Creating $RIBDIR/repositories/$in{repository}/conf/$file ..."; unless (open (FOO, ">$RIBDIR/repositories/$in{repository}/conf/$file")) { print "

\n"; print "

Error

\n"; print "Couldn't open "; print "$RIBDIR/repositories/$in{repository}/conf/$file "; print "for writing.\n"; print "

Reason : $!\n"; print "\n"; print "

Cleaning up...
\n"; &wipe_files(@new_files); &wipe_dirs(@made_dirs); print $back_to_top; exit; } unshift(@new_files,"$RIBDIR/repositories/$in{repository}/conf/$file"); select FOO; if ($file eq 'Asset.header') { print "\n"; print "$in{repository} Software Catalog\n"; print "\n"; print "

\n"; print "$in{repository} Software Catalog\n"; print "

\n"; print "

"; } elsif ($file eq 'Asset.footer') { print "

"; print "$in{contact}\n"; print "\n"; } elsif ($file eq 'main.header') { print "\n"; print "$in{repository} Software Catalog\n"; print "\n"; print "

$in{repository} Software Catalog

\n"; print "

\n"; print "\n"; print "\n"; print "This software catalog was created using "; print "Repository "; print "In a Box (RIB) version ", $RIB::Util::VERSION, "\n"; print "\n"; print "\n"; print "

"; } elsif ($file eq 'main.footer') { print "

"; print "$in{contact}\n"; print "\n"; } close FOO; select STDOUT; print "done.\n"; } print "\n"; print "\n"; print "

Success

\n"; print "A new repository named "$in{repository}""; print " has been created.

\n"; print "You may now start "; print ""; print "using this new repository.

\n"; print "See the RIB User's Guide\n"; print "for help configuring this new\n"; print "repository.\n"; print $back_to_top; print "

\n"; print "Create another repository\n"; print "\n"; exit; } else { print "Create a New Respoitory\n"; print "

Create a New Repository

\n"; print "

\n"; print "["; print "help using this form]

\n"; print "Please choose a name for this repository and enter an email\n"; print "address to be the contact for this repository.

\n"; print "The repository name should contain only "; print "alphanumeric (0-9, A-Z, a-z),\n"; print "dash (-), and underscore ( _ ) characters and should not \n"; print "contain any spaces. The repository name cannot already exist in \n"; print ""; print "$RIBDIR/repositories.\n"; print "Once you choose a name for this repository it cannot be changed. "; print "

\n"; print $form; print "

\n"; print "

\n"; print "\n"; print "IMPORTANT
\n"; print "It is very important that you do not hit the "stop" "; print "button in your web browser while the repository is being created.\n"; print "If you change your mind about creating this repository while it\n"; print "is being created then go ahead and let it finish creating first.\n"; print "You can remove it later from the top RIB page.\n"; print "\n"; print "

\n"; print $back_to_top; exit; }