/ Forside / Teknologi / Udvikling / Perl / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
Perl
#NavnPoint
bjarneA 141
poul_from 50
soccer 30
Nicknack 14
Tmpj 0
Jeg er kørt fast !!! - er der nogen, der k~
Fra : Chr. D. Reventlow


Dato : 06-07-01 00:35

Jeg er kørt fast med et cgi-script og ved ikke hvordan jeg skal komme
videre.

Jeg har gennem et par år på mit website www.reventlow.dk administreret en
slægtsforskningsdatabase, som nu pt består af 15.000 individer. Databasen
rummer oplysninger om en stor del af den danske middelalderadel +
efterkommere af disse og er som sådan meget søgt af slægtsforskere ikke kun
her i landet, men også i udlandet. Derfor er det lidt en katastrofe, at
databasen ikke virker. Jeg har midlertidigt lavet et alternativ baseret på
JAVA, men det fungerer ikke nær så godt.

Inden for slægtsforskningsområdet anvendes et standardiseret filformat
Gedcom5.5 som alle de forskellige slægtsforskningsprogrammer kan læse - til
udveksling af oplysninger, der ligger i databasen.

I mit tilfælde hedder databasen Reventlow.ged - og det er egentlig blot en
almindelig flad ascii-fil, opbygget med poster og "tags" - altså de
forskellige oplysninger om de enkelte individer.

For år tilbage blev der udviklet en programpakke af freeware cgi-scripts,
der kan læse disse filer - altså kan oversætte filer af formatet *.ged til
html. Systemet hedder IGM, hvilket står for "Indexed GEDCOM Method" - og der
findes hundredevis af IGM-databaser på internettet, der således rummer de
forskellige slægtsforskeres materiale.

Mit problem er, at jeg i forbindelse med en opdatering pludselig ikke kan få
det til at virke mere.

Opdateringen bestod af 2 elementer - dels en ny version af min database - og
dels en ny version af selve programellet / cgi-scriptene.

Når jeg tester lokalt på min egen server virker alt i fineste form - Jeg
bruger OptiPerl3, der har en intern server - og der virker script og det
hele perfekt. Mit system kører Win98 og IE55.

Når jeg uploader til min server, der hostes hos Netsite (Linux / Apache) så
er der eet script, der pludselig ikke vil køre korrekt. Dette script skal
læse i ascii-databasen (Reventlow.ged) men vil KUN læse den første post -
istedet for - med udgangspunkt i et andet cgiscript at søge efter den
konkrete person (post) i databasen der ønskes.

Er der nogen, der kan komme med et forslag til hvad der er galt. Der må jo
være en konflikt eet eller andet sted - og da jeg ikke er nogen ørn til
cgi-programmering så kan jeg ikke komme videre uden hjælp.

Jeg kan henvise til følgende urls:

www.reventlow.dk (min hjemmeside)

www.reventlow.dk/gedcom.html (link til min database - jeg har der også lagt
link til de forskellige cgi-scripts - gemt i txt format.

www.reventlow.dk/database.html (link til min "erstatningsdatabase i JAVA)

Det er muligt det er noget helt banalt, men jeg kan ikke ikke finde ud af
det.

mvh

Chr. D. Reventlow
mail: cd@reventlow.dk
web: www.reventlow.dk



 
 
Mogens Dyhre Hansen (06-07-2001)
Kommentar
Fra : Mogens Dyhre Hansen


Dato : 06-07-01 12:16


"Chr. D. Reventlow" <cd@reventlow.dk> skrev i en meddelelse
news:3b44f8d6$0$12759$edfadb0f@dspool01.news.tele.dk...
> I mit tilfælde hedder databasen Reventlow.ged - og det er egentlig blot en
> almindelig flad ascii-fil, opbygget med poster og "tags" - altså de
> forskellige oplysninger om de enkelte individer.

Kan det tænkes at du har uploadet databasen som binærfil istedet for
ascii-fil?

Mogens
--
Svend-bent Index http://www.svend-bent.dk/
Software Shopping 255.000 varenr. http://www.svend-bent.dk/shop/
Haltruplund Dambrug http://hjem.get2net.dk/mogges/
Fiskeriteknologen http://www.fiskeriteknologen.dk/




Hroi Sigurdsson (06-07-2001)
Kommentar
Fra : Hroi Sigurdsson


Dato : 06-07-01 12:35

Mogens Dyhre Hansen wrote:

> Kan det tænkes at du har uploadet databasen som binærfil istedet for
> ascii-fil?

Perl er rimeligt god til selv at konvertere filformater (Mac, Unix, PC),
undtagen når det gælder kildeteksten selv.

--
Hroi Sigurdsson hroi@netgroup.dk
Netgroup A/S http://www.netgroup.dk

Chr. D. Reventlow (06-07-2001)
Kommentar
Fra : Chr. D. Reventlow


Dato : 06-07-01 16:33

Tak for Jeres svar.

Databasen er sendt i ascii-format.

Jeg har eksperimenteret med forskellige variationer af chmod, men uden
resultat.
Jeg har pt følgende:
cgi-scripts = chmod 755
databiblioteket, hvor databasen ligger = chmod 777, der der skal kunne
skrives til en fil
alm html-filer = chmod 644
filer, der skal skrives til = chmod 766

mvh

Chr. D. Reventlow
mail: cd@reventlow.dk
web: www.reventlow.dk

"Hroi Sigurdsson" <hroi@netgroup.dk> skrev i en meddelelse
news:3B45A280.EA4DA195@netgroup.dk...
> Mogens Dyhre Hansen wrote:
>
> > Kan det tænkes at du har uploadet databasen som binærfil istedet for
> > ascii-fil?
>
> Perl er rimeligt god til selv at konvertere filformater (Mac, Unix, PC),
> undtagen når det gælder kildeteksten selv.
>
> --
> Hroi Sigurdsson hroi@netgroup.dk
> Netgroup A/S http://www.netgroup.dk



Chr. D. Reventlow (09-07-2001)
Kommentar
Fra : Chr. D. Reventlow


Dato : 09-07-01 00:00

Jeg er _måske_ kommet lidt videre mht hvad der er galt med mit script - og
håber nu at der er nogen der kan lede mig videre.

1. Jeg har installeret Apache på min egen PC - der kører scriptet
upåklageligt.

2. Jeg har fået kontakt med en kollega i USA, der arbejder med samme
script - i forhold til en Windows NT4 SP5-system. Han beskriver, at der - i
forhold til Windows NT/IIS og Windows 9x / PWS er sket nogle ændringer ved
de seneste servicepacks. Jeg klipper noget fra hans svar til mig - som
desværre ikke virker online, dvs når ændringen er uploaded:

With SP5, MS no longer put the EXTRA PATH DATA into PATH_INFO. This was
supposed to stop a security exposure, but it totally broke IGM.
igmget.cgi/n=database?I123 no longer worked because the /n=database never
got through. The only solution I found was to put all the data in the query
string like igmget.cgi?n=database&I123.

FØRSTE ÆNDRING:
The problem is still in how MS treats PATH_INFO. This will probably fix your
problem for now (dvs på min win98 PC) but may break with SP5:

Old Code:
require 'igmlib';
$tmp=$ENV{'PATH_INFO'};
(($DB)=($tmp=~m#^/n=(.*)#)) || &IGMDie("PATH_INFO \"$tmp\" not in correct
format.");
#

New Code:
require 'igmlib.pl';
$tmp=$ENV{'PATH_INFO'};
(($DB)=($tmp=~m#/n=(.+)$#)) || &IGMDie("PATH_INFO \"$tmp\" not in correct
format.");
#

The fix is in line 3. It looks for /n=database at the end of the line
instead of the beginning. Both work for UNIX and W95. Only the latter works
for UNIX, WIN95, and NT.

Senere foreslår han følgende:

ANDEN ÆNDRING:
With SP5, MS no longer put the EXTRA PATH DATA into PATH_INFO. This was
supposed to stop a security exposure, but it totally broke IGM.
igmget.cgi/n=database?I123 no longer worked because the /n=database never
got through. The only solution I found was to put all the data in the query
string like igmget.cgi?n=database&I123. Of course the parsing routines had
to be rewritten in all the modules that take embedded data. Here's what I
did:

Old Code:
$tmp=$ENV{'PATH_INFO'};
(($DB)=($tmp=~m#^/n=(.*)#)) || &IGMDie("PATH_INFO \"$tmp\" not in correct
format.");
#
$tmp=$ENV{'QUERY_STRING'};
(($key)=($tmp=~/(\w+)/)) || &IGMDie("QUERY_STRING \"$tmp\" not in correct
format.");
#
$focus=$key;

New Code:
@tmp = split /&/, $ENV{QUERY_STRING};
(($DB)=($tmp[0]=~/n=(.+)$/)) || die "QUERY_STRING \"$tmp[0]\" not in correct
format.\n";
(($key)=($tmp[1]=~/(I\d+)$/)) || die "QUERY_STRING \"$tmp[1]\" not in
correct format.\n";
#
$focus=$key;

Den første ændring virker på min kokale Apache server, men ikke på nettet.
Den anden ændring virker hverken lokalt (fejl 500) eller på nettet og giver
følgende meddelelse i error-log:
[Mon Jul 09 00:43:39 2001] [error] [client 127.0.0.1] Premature end of
script headers: d:/data/dokumenter/reventlow.dk/cgi-bin/igmget.cgi
[Mon Jul 09 00:43:39 2001] [error] [client 127.0.0.1] QUERY_STRING "I10469"
not in correct format.

- og hvad betyder så det - og hvad gør man ved det.?? - og er det
overhovedet der problemet ligger.

Er der nogen, der ved om der gør sig tilsvarende forhold gældende på en
Apache webserver hos Netsite, der kører Apache 1.3.20 Server på Linux?? Det
der undrer mig er, at pludselig så vil Netsite's server ikke acceptere mit
script - altså kan der der være blevet installeret noget sikkerhedssoftware
á la SP5 - dvs, der reagerer som ovenfor beskrevet.

mvh

Chr. D. Reventlow
mail: cd@reventlow.dk
web: www.reventlow.dk




Chr. D. Reventlow (09-07-2001)
Kommentar
Fra : Chr. D. Reventlow


Dato : 09-07-01 00:33

Jeg sender en kopi af det script, jeg har vrøvl med. Det kan være det er
nemmere at gennemskue, så. (bare ikke for mig)

OPRINDELIG så linje 26-32 således ud:
$tmp=$ENV{'PATH_INFO'};
(($DB)=($tmp=~m#^/n=(.*)#)) || &IGMDie("PATH_INFO \"$tmp\" not in correct
format.");
#
$tmp=$ENV{'QUERY_STRING'};
(($key)=($tmp=~/(\w+)/)) || &IGMDie("QUERY_STRING \"$tmp\" not in correct
format.");
#
$focus=$key;

FØRSTE ÆNDRING

$tmp=$ENV{'PATH_INFO'};
(($DB)=($tmp=~m#/n=(.+)$#)) || &IGMDie("PATH_INFO \"$tmp\" not in correct
format.");
#
$tmp=$ENV{'QUERY_STRING'};
(($key)=($tmp=~/(\w+)/)) || &IGMDie("QUERY_STRING \"$tmp\" not in correct
format.");
#
$focus=$key;

ANDEN ÆNDRING:
@tmp = split /&/, $ENV{QUERY_STRING};
(($DB)=($tmp[0]=~/n=(.+)$/)) || die "QUERY_STRING \"$tmp[0]\" not in correct
format.\n";
(($key)=($tmp[1]=~/(I\d+)$/)) || die "QUERY_STRING \"$tmp[1]\" not in
correct format.\n";
#
$focus=$key;


SELVE SCRIPTET ser således ud:
#!/usr/bin/perl
#
# igmget, 16 Apr 1996, by Tim Doyle <tdoyle@doit.com>
# by Randy Winch <gumby@edge.net>
# by Doug Macdonald <DAMacdonald@juno.com>
#
############################################################################
#
#
# This program provides for on-the-fly individual page generation
#
# 02 Feb 1998 Revised Family handling and added photo support
# 16 Sep 1997 Changed format of pedigree, descendency, etc., links
# Also added support for $HomePage link
# 15 Sep 1997 Updated source handling & added achema handling
# Added note handling for marriages
# 15 Jun 1999 Changes to handle photos better and miscellaneous other
changes
# (Doug Macdonald)
############################################################################
#
# Some systems might need to uncomment the following line
#$|=1;
$starttime=(times)[0];
$Program='IGMGet';
$Version='2.8';
require 'igmini.cgi';
require 'igmlib.cgi';
@tmp = split /&/, $ENV{QUERY_STRING};
(($DB)=($tmp[0]=~/n=(.+)$/)) || die "QUERY_STRING \"$tmp[0]\" not in correct
format.\n";
(($key)=($tmp[1]=~/(I\d+)$/)) || die "QUERY_STRING \"$tmp[1]\" not in
correct format.\n";
#
$focus=$key;
#
# Read index file or open DBM file
#
if ($UseDBM) {
dbmopen(%idx,"$LocIGMDir/$DB/$DB",undef);
} else {
open(INDEX,"$LocIGMDir/$DB/$DB.idx") || die "Can't open index";
while (<INDEX>) {
/^(\S+) (.*)/;
$idx{$1}=$2;
}
close(INDEX);
}
$key=$idx{$key} if ($UseXrefTags);
#
$lastlvl=100;
open(GEDCOM,"$LocIGMDir/$DB/$DB.ged") || die "Can't open GEDCOM";
#
# Read schema from gedcom file
#
%famschema=();
%indischema=();
$lasttag='';
$nfamilies=0;
$indi='y';
$cnt=0;
<GEDCOM>;
while (<GEDCOM>) {
($lvl,$tag,$rest)=/^(\d+)\s+(\S+) ?(.*)$/o;
last if ($lvl eq '0');
if ($tag eq 'LABL') {
if ($indi) {
$indischema{$lasttag}=$rest;
} else {
$famschema{$lasttag}=$rest;
}
} elsif ($tag eq 'FAM') {
$indi='';
}
$lasttag=$tag;
}
seek(GEDCOM,$key,0);
#
# Read INDI line and get tag for comparison later
#
$_=<GEDCOM>;
($subject)=/^\d+\s+(\S+)\s+.*$/;
&HTMLStart;
$Savename='';
$SourceText='';
$GotSource='';
$lastlvl=0;
$tag='';
$SourceNo=0;
while (<GEDCOM>) {
$lasttag=$tag;
&IGMGetLine;
if ($lvl <= $lastlvl) {
if ($GotSource) {
print &AddSource;
$GotSource='';
$SourceText='';
}
if ($req) {
print "$req";
$req='';
}
$lastlvl=0;
}
last if ($lvl eq '0');
if ($tag eq 'NAME') {
$rest=~s|/| |go;
$rest=~s/\s{2,}/ /go;
$rest=~s/ ,/,/go;
&IGMHTMLHeader(" - $rest");
print "<H1>$rest</H1><HR>\n<ul>";
$Savename=$rest;
next;
}
if ($tag eq 'SEX') {print "\n<li><em>Sex:</em> $rest"; next;}
if ($tag eq 'DATE') {print " $rest"; next;}
if ($tag eq 'PLAC') {print " in $rest"; next;}
if ($tag eq 'BIRT') {print "\n<li><em>Born:</em>"; next;}
if ($tag eq 'DEAT') {print "\n<li><em>Died:</em>"; next;}
if ($tag eq 'FAMC') {push(@Parents,$rest); next}
if ($tag eq 'FAMS') {push(@Children,$rest); $nfamilies++; next}
if ($tag eq 'SOUR') {
print "\n<li><em>Source</em>" if ($lasttag eq 'NAME');
$GotSource='y';
$lastlvl=$lvl;
if ($rest=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
$SourceText=$rest;
}
next;
}
if ($tag eq 'AFN') {print "\n<li><em>AFN:</em> $rest"; next;}
if ($tag eq 'ALIA') {
$rest=~s|/||go;
print "\n<li><em>Also Known As:</em> $rest";
next;
}
next if ($tag eq 'ANCI');
if ($tag eq 'ANEC') {print "<li>$rest"; next;}
next if ($tag eq 'ATTR');
if ($tag eq 'AUTH') {print " $rest"; next;}
if ($tag eq 'BAPM') {print "\n<li><em>Baptized:</em> $rest"; next;}
if ($tag eq 'BAPL') {print "\n<li><em>Baptised LDS: $rest"; next;}
if ($tag eq 'BAPM') {print "\n<li><em>Baptised: $rest"; next;}
if ($tag eq 'BLES') {print "\n<li><em>Blessing: $rest"; next;}
if ($tag eq 'BURI') {print "\n<li><em>Buried:</em>"; next;}
if ($tag eq 'CALN') {print " $rest"; next;}
if ($tag eq 'CEME') {print "\n<li><em>Cemetery:</em> $rest"; next;}
if ($tag eq 'CENS') {print "\n<li><em>Census:</em> $rest"; next;}
if ($tag eq 'CHAN') {print "\n<li><em>Record last updated:</em> $rest";
next;}
if ($tag eq 'CHR') {print "\n<li><em>Christened:</em> $rest"; next;}
if ($tag eq 'CONC') {
if ($GotSource) {
$SourceText.="$rest";
} else {
print "$rest";
}
next;
}
if ($tag eq 'CONF') {print "\n<li><em>Confirmed:</em> $rest"; next;}
if ($tag eq 'CONT') {
if ($GotSource) {
$SourceText.="<br>\n$rest";
} else {
print "<br>\n$rest";
}
next;
}
if ($tag eq 'DIVF') {print "\n<li><em>Divorce Filed:</em> $rest "; next;}
if ($tag eq 'EDUC') {print "\n<li><em>Educated:</em> $rest"; next;}
if ($tag eq 'EMIG') {print "\n<li><em>Emigrated:</em> $rest"; next;}
if ($tag eq 'EMPL') {print "\n<li><em>Employed:</em> $rest"; next;}
if ($tag eq 'ENGA') {print "\n<li><em>Engaged:</em> $rest"; next;}
next if ($tag eq 'EVEN');
if ($tag eq 'FCOM') { print "<BR><B>1st Communion:</B> $rest"; next;}
if ($tag eq 'FIDE') {next;}
if ($tag eq 'FILM') {print "microfilm number $rest"; next;}
if ($tag eq 'FREE') {print "\n<li><em>Made Freeman:</em> $rest"; next;}
if ($tag eq 'FROM') {print "\n<li><em>From:</em> $rest"; next;}
if ($tag eq 'FUNR') {print "\n<li><em>Funeral:</em> $rest"; next;}
if ($tag eq 'HOBY') {print "\n<li><em>Hobby:</em> $rest"; next;}
if ($tag eq 'GRAD') {print "\n<li><em>Graduated:</em> $rest"; next;}
if ($tag eq 'OCCU') {print "\n<li><em>Occupation:</em> $rest"; next;}
if ($tag eq 'RELI') {print "\n<li><em>Religion:</em> $rest"; next;}
if ($tag eq 'REFN') {print "\n<li><em>Reference:</em> $rest"; next;}
if ($tag eq 'IMMI') {print "\n<li><em>Immigrated:</em> $rest"; next;}
if ($tag eq 'NOTE') {
print "\n<li><em>Notes:</em><blockquote>\n";
$req='</blockquote>';
$lastlvl=$lvl;
if ($rest=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
print "$rest";
}
next;
}
if ($tag eq 'PAGE') {&AddSourceItem('Page:'); next;}
if ($tag eq 'PHOT') {
$thumb=$rest;
$thumb=~s/\./_thumb\./go;
if ( -e "$LocIGMDir/$PictureDir/$thumb" ) {
print "\n<A HREF=\"$WebSite/$WebIGMDir/$PictureDir/$rest\"><IMG
src=$WebSite/$WebIGMDir/$PictureDir/$thumb alt=\"Picture $rest\" height=200
border=0></A>&nbsp;";
}
else {
print "\n<A HREF=\"$WebSite/$WebIGMDir/$PictureDir/$rest\"><IMG
src=$WebSite/$WebIGMDir/$PictureDir/$rest alt=\"Picture $rest\" height=200
border=0></A>&nbsp;";
}
next;
}
if ($tag eq 'TEXT') {&AddSourceItem('Text:'); next;}
if ($tag eq 'QUAY') {&AddSourceItem('Quality:'); next;}
if ($tag eq 'TITL') {&AddSourceItem('Title:'); next;}
if ($tag eq 'TYPE') {print "\n<li><em>$rest:</em> "; next;}
#
# Check schema
#
$label=$indischema{$tag};
if ($label) {print "\n<li><em>$label:</em> $rest"; next};
#
# Tags from Family Tree Maker Program
#
if ($tag eq '_FA1') {print "\n<li><em>Christened:</em> $rest"; next;}
if ($tag eq '_FA2') {print "\n<li><em>Buried:</em> $rest"; next;}
if ($tag eq '_FA3') {print "\n<li><em>Baptism:</em> $rest"; next;}
if ($tag eq '_FA4') {print "\n<li><em>Fact 1:</em> $rest"; next;}
if ($tag eq '_FA5') {print "\n<li><em>Fact 2:</em> $rest"; next;}
if ($tag eq '_FA6') {print "\n<li><em>Occupation:</em> $rest"; next;}
if ($tag eq '_FA7') {print "\n<li><em>Titles:</em> $rest"; next;}
if ($tag eq '_FA8') {print "\n<li><em>Education:</em> $rest"; next;}
if ($tag eq '_FA9') {print "\n<li><em>SSN:</em> $rest"; next;}
if ($tag eq '_FA10') {print "\n<li><em>Last Residence:</em> $rest"; next;}
if ($tag eq '_FA11') {print "\n<li><em>State of Issue:</em> $rest"; next;}
if ($tag eq '_FA12') {print "\n<li><em>Zip of Payment:</em> $rest"; next;}
if ($tag eq '_FA13') {print "\n<li><em>Military Service:</em> $rest";
next;}
if ($tag eq '_MREL') {print "\n<li><em>Relationship to Mother:</em>
$rest"; next;}
if ($tag eq '_FREL') {print "\n<li><em>Relationship to Father:</em>
$rest"; next;}

print "\n<li><em>$tag:</em> $rest" if ($rest ne '');
}
print '</ul>';
#
# Handle Parents
#
$Gotparent='';
foreach $parent (@Parents) {
($key)=($parent=~/@(\S+)@/o);
$key=$idx{$key};
seek(GEDCOM,$key,0) || die "Can't seek to $key";
<GEDCOM>;
while (<GEDCOM>) {
&IGMGetLine;
last if ($lvl eq '0');
if ($tag eq 'HUSB') {
print "<br>\n<em>Father: </em>";
$Gotparent='y';
&DoParent($rest);
} elsif ($tag eq 'WIFE') {
$Gotparent='y';
print "<br>\n<em>Mother: </em>";
&DoParent($rest);
}
}
}
print "<br>\n";
#
# Handle Families
#
$kid=1;
$family=1;
@req=();
$Gotkid='';
foreach $child (@Children) {
print "<br>\n<em>Spouse";
print " $family" if ($nfamilies > 1);
print ":</em> ";
$family++;
$nchildren=0;
$GotSpouse='';
($child)=($child=~/@(\S+)@/o);
@Temp=();
seek(GEDCOM,$idx{$child},0) || die "Can't seek to $child";
<GEDCOM>;
$GotSource='';
$lastlvl=0;
while (<GEDCOM>) {
&IGMGetLine;
if ($lvl <= $lastlvl) {
if ($GotSource) {
print &AddSource;
$GotSource='';
$SourceText='';
}
if ($req[$lvl]) {
print "$req[$lvl]";
$req[$lvl]='';
}
$lastlvl=0;
}
last if ($lvl eq '0');
if ($tag eq 'CHIL') {push(@Temp,$rest); $Gotkid='y'; $nchildren++;
next;}
if ($tag eq 'HUSB') {
if ($rest ne $subject) {
&DoParent($rest);
$req[0]='</ul>';
print "<ul>";
$GotSpouse='y';
}
next;
}
if ($tag eq 'WIFE') {
if ($rest ne $subject) {
&DoParent($rest);
$req[0]='</ul>';
print "<ul>";
$GotSpouse='y';
}
next;
}
if ($tag eq 'CONC') {
if ($GotSource) {
$SourceText.="$rest";
} else {
print "$rest";
}
next;
}
if ($tag eq 'CONT') {
if ($GotSource) {
$SourceText.="<br>\n$rest";
} else {
print "<br>\n$rest";
}
next;
}
if ($GotSpouse eq '') {
print "\n<ul>";
$req[0]='</ul>';
$GotSpouse='y';
}
if ($tag eq 'DIV') {print "\n<li><em>Divorced:</em> $rest"; next;}
if ($tag eq 'DIVF') {print "\n<li><em>Divorce Filed:</em> $rest"; next;}
if ($tag eq 'ANUL') {
print "\n<li><em>Annulment:</em> $rest";
next;
}
if ($tag eq 'ENGA') {
print "\n<li><em>Engagement:</em> $rest";
next;
}
if ($tag eq 'CENS') {
print "\n<li><em>Census:</em> $rest";
next;
}
if ($tag eq 'MARB') {
print "\n<li><em>Marriage Bann:</em> $rest";
next;
}
if ($tag eq 'MARC') {
print "\n<li><em>Marriage Contract:</em> $rest";
next;
}
if ($tag eq 'MARL') {
print "\n<li><em>Marriage License:</em> $rest";
next;
}
if ($tag eq 'MARR') {
print "\n<li><em>Married:</em> $rest";
next;
}
if ($tag eq 'MARS') {print "\n<li><em>Marriage Settlement:</em> $rest";
next;}
if ($tag eq 'DATE') {print " $rest"; next;}
if ($tag eq 'PLAC') {print " in $rest"; next;}
if ($tag eq 'SOUR') {
# print "\n<li><em>Source</em>" if ($lasttag eq 'NAME');
$GotSource='y';
$lastlvl=$lvl;
if ($rest=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
$SourceText=$rest;
}
next;
}
if ($tag eq 'PAGE') {&AddSourceItem('Page:'); next;}
if ($tag eq 'TEXT') {&AddSourceItem('Text:'); next;}
if ($tag eq 'QUAY') {&AddSourceItem('Quality:'); next;}
if ($tag eq 'TITL') {&AddSourceItem('Title:'); next;}
if ($tag eq 'NOTE') {
print "\n<li><em>Notes:</em><blockquote>\n";
$req[$lvl]='</blockquote>';
$lastlvl=$lvl;
if ($rest=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
print "$rest";
}
next;
}
$label=$famschema{$tag};
print "\n<li><em>$label:</em> $rest" if ($label);
}
print $req[0] if ($req[0] ne '');
print "\n<em>Children:</em>" if ($nchildren != 0);
print '<ol>';
#
# Now print children's names and birthdates
#
foreach $child (@Temp) {
print "\n<li>";
&DoParent($child);
}
print '</ol>';
}
if ($SourceNo > 0) {
print "<br>\nSources:<br>\n<ol>\n";
$SourceNo=0;
foreach $SourceText (@Sources) {
$SourceNo++;
print "<A NAME=\"S$SourceNo\"></NAME><li>";
if ($SourceText=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
print "$SourceText";
}
}
}
print "</ul><br>\n";
#
# URL Encode Savename into EncodeName
#
$EncodeName=&escape($Savename);
#
# If links are allowed the show them and allow additions
#
if ($AllowLinks) {
if (open(LINK,"$LocIGMDir/$DB/$DB-$focus.lnk")) {
print "<h2>Links:</h2>\n";
while (<LINK>) {
(($url,$desc)=/(.*)\|(.*)/);
#
# Handle old style links if they exist.
#
if ($url eq '') {
(($url,$desc)=/(.*)\,(.*)/);
}
print "<A HREF=\"$url\">$desc</A><BR>\n";
}
print "<br>\n";
}
}
print "<TABLE CELLPADDING=1 BORDER=2 WIDTH=\"80%\">\n";
if ($Gotparent) {
print "<TR><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=$WebSite/$WebCGIDir/$PedTreeScript/n=$DB?$focus>Show
Pedigree Chart (Tree form)</A>\n";
print "</TD><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=$WebSite/$WebCGIDir/$PedScript/n=$DB?$focus>Show Pedigree
Chart (Text form)</A>\n";
print "</TD></TR>\n";
}
if ($Gotkid) {
print "<TR><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=$WebSite/$WebCGIDir/$DescTreeScript/n=$DB?$focus>Show
Descendency Chart (Tree form)</A>\n";
print "</TD><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=$WebSite/$WebCGIDir/$DescScript/n=$DB?$focus>Show
Descendency Chart (Text form)</A>\n";
print "</TD></TR>\n";
}
#
# If GEDCOM extraction is allowed the show them and allow additions
#
print "<TR><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
if ($AllowGED) {
print "<a
href=$WebSite/$WebCGIDir/$GedScript?Database=$DB&Subject=$focus&Name=$Encode
Name>Extract GEDCOM</a>\n";
}
print "</TD><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
if ($AllowLinks) {
print "<a
href=$WebSite/$WebCGIDir/$LinkScript?Database=$DB&Subject=$focus&Name=$Encod
eName>Add a Link</a>\n";
}
print "</TD></TR>\n";

print "<TR><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=\"$WebSite/$WebIGMDir/$DB/$DB.$Suffix\">Master Index</A>\n";
print "</TD><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=\"$WebSite/$WebIGMDir/$DB/$DB-surname.$Suffix\">Surname
Index</A>\n";
print "</TD></TR>\n";
print "<TR><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<a href=$WebSite/$WebCGIDir/$SrchScript/n=$DB>Search</a>\n";
print "</TD><TD ALIGN=\"CENTER\"><FONT SIZE=2>";
print "<A HREF=$HomePage>Home Page</A>\n" if ($HomePage);
print "</TD></TR>\n";
print "</TABLE>\n";

&IGMEnd;
dbmclose(%idx) if ($UseDBM);
$time=(times)[0]-$starttime;
&IGMLog("Individual $Savename accessed");

#
# Subroutine to print name and birthdate
#
sub DoParent {
($key)=@_;
$oldseek=tell;
($key)=($key=~/@(\S+)@/o);
$seek=$idx{$key};
$key=$seek unless ($UseXrefTags);
seek(GEDCOM,$seek,0) || die "Can't seek to $key";
$type='';
$birth='';
$death='';
$photo='';
<GEDCOM>;
while (<GEDCOM>) {
&IGMGetLine;
last if ($lvl eq '0');
if ($tag eq 'NAME') {
$rest=~s|/||go;
print "<A HREF=$WebSite/$WebCGIDir/$GetScript/n=$DB?$key>$rest</A>";
}
if ($type eq 'BIRT') {
$birth=$rest if ($tag eq 'DATE');
if ($tag eq 'PLAC') {
$birth.=' ' if ($birth);
$birth.="in $rest";
}
}
if ($type eq 'DEAT') {
$death=$rest if ($tag eq 'DATE');
if ($tag eq 'PLAC') {
$death.=' ' if ($death);
$death.="in $rest";
}
}
if ($tag eq 'PHOT') {
$photo='y';
}
$type=$tag if ($rest eq '');
}
print ", <B>b.</B> $birth" if ($birth);
print ", <B>d.</B> $death" if ($death);
print " <IMG SRC=\"/$WebIGMDir/$Photo\" ALT=\"*Photo*\">" if ($photo);
seek(GEDCOM,$oldseek,0) || die "Can't seek to $oldseek";
}

#
# Subroutine to print notes via Xref tag
#
sub DoNotes {
($key)=@_;
local($oldseek)=tell;
($key)=($key=~/@(\S+)@/o);
seek(GEDCOM,$idx{$key},0) || die "Can't seek to $key";
$_=<GEDCOM>;
&IGMGetLine;
if ($rest=~/^NOTE (.*)/) {
if ($GotSource) {
$SourceText.=$1;
} else {
print $1;
}
}
while (<GEDCOM>) {
&IGMGetLine;
last if ($lvl eq '0');
if ($tag eq 'CONC') {
if ($GotSource) {
$SourceText.="$rest";
} else {
print "$rest";
}
next;
}
if ($tag eq 'CONT') {
if ($GotSource) {
$SourceText.="<br>\n$rest";
} else {
print "<br>\n$rest";
}
next;
}
if ($tag eq 'TITL') {&AddSourceItem('Title:'); next;}
if ($tag eq 'AUTH') {&AddSourceItem('Author:'); next;}
if ($tag eq 'PUBL') {&AddSourceItem('Publication:'); next;}
if (($tag eq 'CALN') && ($rest)) {&AddSourceItem('Call Number:'); next;}
if ($tag eq 'MEDI') {&AddSourceItem('Media:'); next;}
if ($tag eq 'NOTE') {
if ($GotSource) {
$SourceText.='<br>' if ($SourceText);
$SourceText.="Note: ";
} else {
print " Note: ";
}
if ($rest=~/@(\S+)@/o) {
&DoNotes($rest);
} else {
if ($GotSource) {
$SourceText.="$rest";
} else {
print "$rest";
}
}
next;
}
&AddSourceItem("$tag");
}
seek(GEDCOM,$oldseek,0) || die "Can't seek to $oldseek";
}
#
# Subroutine to print source or footnote of source
#
sub AddSource {
if ($InlineSource) {
return "[source: $SourceText]";
} else {
$i=1;
foreach $s (@Sources) {
return "<A HREF=\"#S$i\"><SUP>$i</SUP></A>" if ($s eq $SourceText);
$i++;
}
push(@Sources,$SourceText);
$SourceNo++;
return "<A HREF=\"#S$SourceNo\"><SUP>$SourceNo</SUP></A>";
}
}

sub AddSourceItem {
($t)=@_;
if ($GotSource) {
$SourceText.='<br>' if ($SourceText);
$SourceText.="$t $rest";
} else {
print "\n<li><em>$t</em> $rest";
}
}


--
mvh

Chr. D. Reventlow
mail: cd@reventlow.dk
web: www.reventlow.dk



Trond Michelsen (09-07-2001)
Kommentar
Fra : Trond Michelsen


Dato : 09-07-01 01:01

Chr. D. Reventlow <cd@reventlow.dk> skrev i
meldingsnyheter:3b48e4ef$0$283$edfadb0f@dspool01.news.tele.dk...
> Jeg er _måske_ kommet lidt videre mht hvad der er galt med mit script - og
> håber nu at der er nogen der kan lede mig videre.

[...]

> With SP5, MS no longer put the EXTRA PATH DATA into PATH_INFO. This was
> supposed to stop a security exposure, but it totally broke IGM.

Eeeek.

legg opp følgende script på serveren:

---------8<----------
#!/usr/bin/perl

print "Content-type: text/plain\n\n";
foreach my $k (sort keys %ENV) {
print "$k -> $ENV{$k}\n";
}
---------8<----------

kall det f.eks env.cgi

så kaller du det opp med de samme parametre som du bruker på scriptet ditt,
f.eks

http://server.com/cgi-bin/env.cgi/n=database?I123

Send outputen tilbak hit, så kan vi se om det lar seg fikse på en enkel
måte.



> Den første ændring virker på min kokale Apache server, men ikke på nettet.

Da er nok SP5 installert på serveren

> Den anden ændring virker hverken lokalt (fejl 500) eller på nettet og
giver
> følgende meddelelse i error-log:
> [Mon Jul 09 00:43:39 2001] [error] [client 127.0.0.1] Premature end of
> script headers: d:/data/dokumenter/reventlow.dk/cgi-bin/igmget.cgi

Dette er fordi scriptet dør uten å ha skrevet ferdig headeren

> [Mon Jul 09 00:43:39 2001] [error] [client 127.0.0.1] QUERY_STRING
"I10469"
> not in correct format.

Dette er fordi denne testen feiler.

(($key)=($tmp[1]=~/(I\d+)$/)) || die "QUERY_STRING \"$tmp[1]\" not in
correct format.\n";

Men dette virker litt rart. I dette tilfellet er $tmp[1] lik "I10469", og
dette skal matche regexen /I\d+$/

> - og hvad betyder så det - og hvad gør man ved det.?? - og er det
> overhovedet der problemet ligger.

Jeg vil si at hovedproblemet er at scriptet misbruker PATH_INFO og
QUERY_STRING, samtidig som det ikke gjør noen spesiellt god jobb med å parse
noen av delene.

Men - som din amerikanske venn har sagt. Det som fører til at det originale
scriptet feiler, er nok at PATH_INFO ikke blir satt. Det er ikke umulig at
vi kan rette opp Microsofts vandalisme, så kan vi la resten av scriptet stå
urørt.

> Er der nogen, der ved om der gør sig tilsvarende forhold gældende på en
> Apache webserver hos Netsite, der kører Apache 1.3.20 Server på Linux??
Det
> der undrer mig er, at pludselig så vil Netsite's server ikke acceptere mit
> script - altså kan der der være blevet installeret noget
sikkerhedssoftware
> á la SP5 - dvs, der reagerer som ovenfor beskrevet.

Jeg har ikke tilgang til noen 1.3.20 installasjon av Apache på noen
plattform, dessverre, så jeg vet ikke med sikkerhet. Men jeg tviler sterkt
på at Apache har slått av "PATH_INFO" - dette høres ut som en typisk
tankeløs Microsoft-blunder.

--
Trond Michelsen




Chr. D. Reventlow (09-07-2001)
Kommentar
Fra : Chr. D. Reventlow


Dato : 09-07-01 11:52

"Trond Michelsen" <trondmm-usenet@crusaders.no> skrev i en meddelelse
news:Yu627.8426$qR5.930079@news01.chello.no...

> legg opp følgende script på serveren:
>
> ---------8<----------
> #!/usr/bin/perl
>
> print "Content-type: text/plain\n\n";
> foreach my $k (sort keys %ENV) {
> print "$k -> $ENV{$k}\n";
> }
> ---------8<----------
>
> kall det f.eks env.cgi
>
> så kaller du det opp med de samme parametre som du bruker på scriptet
ditt,
> f.eks
>
> http://server.com/cgi-bin/env.cgi/n=database?I123
>
> Send outputen tilbak hit, så kan vi se om det lar seg fikse på en enkel
> måte.

Det gav følgende resultat:

DOCUMENT_ROOT -> /www/reventlow.dk/web
GATEWAY_INTERFACE -> CGI/1.1
HTTP_ACCEPT -> */*
HTTP_ACCEPT_ENCODING -> gzip, deflate
HTTP_ACCEPT_LANGUAGE -> da
HTTP_CONNECTION -> Keep-Alive
HTTP_HOST -> www.reventlow.dk
HTTP_USER_AGENT -> Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)
PATH ->
/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/usr/bin/X11:/u
sr/X11R6/bin:/root/bin
PATH_INFO -> /n=Reventlow
PATH_TRANSLATED -> /www/reventlow.dk/web/n=Reventlow
QUERY_STRING -> I123
REDIRECT_QUERY_STRING -> I123
REDIRECT_STATUS -> 200
REDIRECT_URL -> /cgi-bin/env.cgi/n=Reventlow
REMOTE_ADDR -> 62.243.192.189
REMOTE_PORT -> 1057
REQUEST_METHOD -> GET
REQUEST_URI -> /cgi-bin/env.cgi/n=Reventlow?I123
SCRIPT_FILENAME -> /usr/local/cgi-wrap/cgiwrap
SCRIPT_NAME -> /cgiwrapDir/cgiwrap/reventlow/cgi-bin/env.cgi
SERVER_ADDR -> 62.89.1.10
SERVER_ADMIN -> webmaster@reventlow.dk
SERVER_NAME -> www.reventlow.dk
SERVER_PORT -> 80
SERVER_PROTOCOL -> HTTP/1.1
SERVER_SIGNATURE -> <ADDRESS>Apache/1.3.20 Server at www.reventlow.dk Port
80</ADDRESS>

SERVER_SOFTWARE -> Apache/1.3.20 (Unix) PHP/4.0.5

Det samme script kørt lokalt på min egen server gav følgende:

COMSPEC -> C:\WINDOWS\COMMAND.COM
DOCUMENT_ROOT -> d:/data/dokumenter/reventlow.dk
GATEWAY_INTERFACE -> CGI/1.1
HTTP_ACCEPT -> image/gif, image/x-xbitmap, image/jpeg, image/pjpeg,
application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword,
application/pdf, */*
HTTP_ACCEPT_ENCODING -> gzip, deflate
HTTP_ACCEPT_LANGUAGE -> da
HTTP_CONNECTION -> Keep-Alive
HTTP_HOST -> localhost
HTTP_USER_AGENT -> Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)
PATH ->
C:\PROGRA~1\WIN98RK;C:\WINDOWS;C:\WINDOWS\COMMAND;;C:\PERL\BIN;C:\PROGRAMMER
\MTS;C:\HTTPD\PHP
PATH_INFO -> /n=Reventlow
PATH_TRANSLATED -> d:\data\dokumenter\reventlow.dk\n=reventlow
QUERY_STRING -> I123
REMOTE_ADDR -> 127.0.0.1
REMOTE_PORT -> 1050
REQUEST_METHOD -> GET
REQUEST_URI -> /cgi-bin/env.cgi/n=Reventlow?I123
SCRIPT_FILENAME -> d:/data/dokumenter/reventlow.dk/cgi-bin/env.cgi
SCRIPT_NAME -> /cgi-bin/env.cgi
SERVER_ADDR -> 127.0.0.1
SERVER_ADMIN -> cd@reventlow.dk
SERVER_NAME -> 127.0.0.1
SERVER_PORT -> 80
SERVER_PROTOCOL -> HTTP/1.1
SERVER_SIGNATURE -> <ADDRESS>Apache/1.3.20 Server at 127.0.0.1 Port
80</ADDRESS>

SERVER_SOFTWARE -> Apache/1.3.20 (Win32)
WINDIR -> C:\WINDOWS

mvh

Chr. D. Reventlow
mail: cd@reventlow.dk
web: www.reventlow.dk




Trond Michelsen (09-07-2001)
Kommentar
Fra : Trond Michelsen


Dato : 09-07-01 13:04

"Chr. D. Reventlow" <cd@reventlow.dk> wrote in message
news:3b498bf3$0$306$edfadb0f@dspool01.news.tele.dk...
> "Trond Michelsen" <trondmm-usenet@crusaders.no> skrev i en meddelelse
> news:Yu627.8426$qR5.930079@news01.chello.no...
>> Send outputen tilbak hit, så kan vi se om det lar seg fikse på en
enkel
>> måte.
> Det gav følgende resultat:
> PATH_INFO -> /n=Reventlow

Uh... PATH_INFO ser ut til å være som den skal.

Da er det noe annet som er galt.

--
Trond Michelsen




Ask Bjoern Hansen (10-07-2001)
Kommentar
Fra : Ask Bjoern Hansen


Dato : 10-07-01 09:28

"Trond Michelsen" <trondmm-usenet@crusaders.no> writes:

[PATH_INFO strippet]
> > Er der nogen, der ved om der gør sig tilsvarende forhold gældende på en
> > Apache webserver hos Netsite, der kører Apache 1.3.20 Server på Linux??

Med Apache 1.3.20 skulle PATH_INFO eksistere under mod_cgi som den
altid har gjort.

--
ask bjoern hansen, http://ask.netcetera.dk/ !try; do();

Søg
Reklame
Statistik
Spørgsmål : 177560
Tips : 31968
Nyheder : 719565
Indlæg : 6408943
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste