{$M $4000,0,327680 }
program dft;
{ NEW FEATURES:
d * Shell command. Precede a DOS command with !
* Auto-open. Watch as it magically finds your ext2 partitions!
e * Color ls !
* fakeget command. Watch how inefficient writing to a DOS drive is!
* multiple directory cd!
* piping. ls |more works!
* sorted ls!
* ini file!
* bleedin' clever output buffering!
* echo command!
f * custom readln. just to be swanky!
* supports files with holes. can't believe i missed this!
* ls -al (with correct sorting for ls without -l) !
g * sped up download (again) using move and fillchar !
* fixed ls wrapping problem!
* sped up download (again) by reading directly to dosbuf !
* fixed fakeget bug (it, basically, well, didn't work) !
* df command!
* ini file renamed to rc !
h * all quit commands changed to quit even if a partition is open
i * showblock command
* additional comment char (#)
* debug command
* dumpfs
* big bug fixed (was assuming too much)
* ofs command
* 95 lfn
* command history (with %)
* ^Z to shell
* ! is now history, and !! works
* " is shell
* ^U clears line
* esc, tab, ^d completion
* ^C aborts line
* scrollable history with Cup/Pup and Cdn/Pdn
* ^A/Home and ^E/End
* left and right cursor
* del
j * cat command
* some fncomp bugs fixed
}
{ WARNING:: NO support for indirect/double/triple in ls/cd }
{ WARNING:: NO support for triple indirect in get }
{ this is not nice code, it's just a hack to test a theorem }
{ just about works... }
{ things to add....
done! error message if invalid command typed
done! ÷ display of current path
done! direct entry of inode (for difficult to resolve names)
done! ÷ support for multiple block directories
done! some buffering (after tprof results :(
symbolic link support
/* some sort of wildcards*/
/* mouse control would be nice (cut & paste)*/
done! dos shell commands
done! ÷ oh, and maybe some file transfer...
done! ÷ perhaps... make it work on OTHER people's filesystems? (blocksize)
done! sort directory output (linked list methinks)
done! change multiple directories (ie cd /usr/bin)
done! ÷ color ls!! + support for /etc/DIR_COLORS
done! win95 lfn
done! command history /* cmdptr, cmdnode */
done! filename completion
overwrite files on ext2fs (?)
should auto-open first ext2fs? NO! first may be invalid
cat command
anybody want an interface?
}
uses
crt,dos;
const
hexchars:array[0..15] of char='0123456789ABCDEF';
checkbreak:boolean=true;
maxdrive=4;
BLOCK_SIZE=1024;
INODE_SIZE=128;
progname='dft';
version='0.0.1j';
compiledate='1st November 1998';
scratch_size=256;
block_bufs=16;
inode_bufs=16;
author='Andrew J Wales (andrew.wales@virgin.net)';
shell='COMMAND.COM';
rcfilename=progname+'.rc';
debug:boolean=false;
namestart=37; { this is the byte offset in each line of the ls output of the filename }
dosbufsize=60; { this is BLOCK_SIZE units }
sourcelines=2573;
sourcebytes=65220;
noechochar='@';
commentchar=';#';
lsspace=2;
emptyblockchar='%';
realblockchar='#';
speeddiff=98.32/46.30;
oldspeed=18.73/1.15;
histchar='!';
{ the following is taken from ext2_fs.h }
EXT2_NDIR_BLOCKS=12;
EXT2_IND_BLOCK=EXT2_NDIR_BLOCKS;
EXT2_DIND_BLOCK=(EXT2_IND_BLOCK + 1);
EXT2_TIND_BLOCK=(EXT2_DIND_BLOCK + 1);
EXT2_N_BLOCKS=(EXT2_TIND_BLOCK + 1);
type
ext2_inode=record
i_mode:word;
i_uid:word;
i_size:longint;
i_atime:longint;
i_ctime:longint;
i_mtime:longint;
i_dtime:longint;
i_gid:word;
i_links_count:word;
i_blocks:longint;
i_flags:longint;
i_reserved1:longint;
i_block:array[0..EXT2_N_BLOCKS-1] of longint;
i_version:longint;
i_file_acl:longint;
i_dir_acl:longint;
i_faddr:longint;
i_frag:byte;
i_fsize:byte;
i_pad1:word;
i_reserved2:array[1..2] of longint;
end;
lslistptr=^lslistnode;
lslistnode=record
entry:string;
link:lslistptr;
end;
dosbuffer=array[0..dosbufsize*BLOCK_SIZE-1] of byte;
cmdptr=^cmdnode;
cmdnode=record
cmd:string;
prev,next:cmdptr;
end;
var
buf:array[0..block_bufs-1,0..BLOCK_SIZE-1] of byte;
regs:registers;
x,y:word;
ch:char;
drive,part:byte;
heads,secs,cyls:word;
c,s,h:word;
_unit:longint;
len:longint;
par:string;
inp,partn:string;
conn,xit:boolean;
partinf:array[0..maxdrive-1,0..3,0..15] of byte;
diskpar:array[0..maxdrive-1,0..2] of word;
start,fin:longint;
pwd:string;
blocks,inodes,fdz,zonesize,maxsize:longint;
block,inode,inf_inode,tblock,cblock:longint;
bpg,ipg:longint;
templ1,templ2:longint;
offs:word;
links:word;
tempstr:string;
pblock:longint;
inode_dat:array[0..inode_bufs] of ext2_inode;
scratch:array[0..scratch_size-1] of longint;
valid:boolean;
slink,what_we_want:boolean;
pause:boolean;
bootdev:char; { char of bootdev, ie 'C' }
canshell:boolean; { can we shell, ie, cli found? }
cli:string; { this holds the drive+path+filename of the cli }
e2found:word; { this holds the number of ext2fss found }
rcfile:boolean; { this determines whether we will be autorunning }
curcol:byte;
shall_we_write:boolean;
color:boolean;
scratchstring:string;
dosbuf:^dosbuffer;
bufp:longint; { this records the current block number to write in the buffer }
bufcon:longint; { this records how many bytes are in the buffer }
maxlen:longint; { max filename len, used in ls }
perline,percol,wide,cline,cacr,cent,toent:longint;
numentries:longint;
screenwidth,screenheight:longint;
hash:boolean;
tl1,tl2,tl3,tl4:longint;
ts1:string;
shitiofs:longint;
cmdhead,cmdtail:cmdptr;
grpblk:longint;
lfn95:boolean;
blksz,cmdno:longint;
prompt:string;
{ cool recursive functions }
function hex4(b:byte):char;
begin
b:=b and $f;
hex4:=hexchars[b]
end;
function hex8(b:byte):string;
begin
hex8:=hex4(b shr 4)+hex4(b);
end;
function hex16(b:word):string;
begin
hex16:=hex8(b shr 8)+hex8(b);
end;
function hex32(b:longint):string;
begin
hex32:=hex16(b shr 16)+hex16(b);
end;
function strtoint(s:string):longint;
var
l:longint;
m:integer;
begin
val(s,l,m);
strtoint:=l;
end;
function inttostr(l,w:longint):string;
var
m:integer;
s:string;
begin
str(l:w,s);
inttostr:=s;
end;
procedure wait_key;
var
ch:char;
begin
while keypressed do
ch:=readkey;
repeat
until keypressed;
while keypressed do
ch:=readkey;
end;
function os_type(b:byte):string;
begin
case b of
$00:os_type:='Empty';
$01:os_type:='DOS 12-bit FAT';
$02:os_type:='XENIX root';
$03:os_type:='XENIX usr';
$04:os_type:='DOS 16-bit <32M';
$05:os_type:='Extended';
$06:os_type:='DOS 16-bit >=32';
$07:os_type:='OS/2 HPFS';
$08:os_type:='AIX';
$09:os_type:='AIX bootable';
$0a:os_type:='OS/2 Boot Manag';
$40:os_type:='Venix 80286';
$51:os_type:='Novell?';
$52:os_type:='Microport';
$63:os_type:='GNU HURD';
$64:os_type:='Novell';
$75:os_type:='PC/IX';
$80:os_type:='Old MINIX';
$81:os_type:='Linux/MINIX';
$82:os_type:='Linux swap';
$83:os_type:='Linux native';
$93:os_type:='Amoeba';
$94:os_type:='Amoeba BBT';
$a5:os_type:='BSD/386';
$b7:os_type:='BSDI fs';
$b8:os_type:='BSDI swap';
$c7:os_type:='Syrinx';
$db:os_type:='CP/M';
$e1:os_type:='DOS access';
$e3:os_type:='DOS R/O';
$f2:os_type:='DOS secondary';
$ff:os_type:='BBT';
else
os_type:='Unknown';
end;
end;
function nolead0(st:string):string;
var
x:byte;
begin
if st[1]='0' then
begin
x:=1;
while (st[x]='0') do
begin
st[x]:=' ';
inc(x);
end;
end;
if (st[length(st)]=' ') then
st[length(st)]:='0';
nolead0:=st;
end;
function doserr(err:integer):string;
begin
case err of
2:doserr:='file not found';
3:doserr:='path not found';
5:doserr:='access denied';
6:doserr:='invalid handle';
8:doserr:='not enough memory';
10:doserr:='invalid environment';
11:doserr:='invalid format';
18:doserr:='no more files';
end;
end;
procedure read_block(bno:longint;var buffer:byte;st:longint);
var
c,h,s:longint;
lsec:longint;
begin
if debug then
writeln('reading block ',bno);
{ this little statement is the support for files with holes }
if (bno=0) then
begin
{ for c:=0 to BLOCK_SIZE-1 do
mem[seg(buffer):ofs(buffer)+c]:=0;}
fillchar(buffer,BLOCK_SIZE,0);
{ write(emptyblockchar);}
exit;
end;
{ writeln(hex32(st));}
c:=(st and $ff)+(longint(st shr 8) and (128+64)) shl 2;
s:=((st shr 8) and (1+2+4+8+16+32));
h:=(st shr 16) and $ff;
{ writeln('c=',c,' s=',s,' h=',h);}
{ c:=st and $3f;
s:=((st shr 8) and $ff)+(longint(st and $c0) shl 2);
h:=(st shr 16) and $ff;}
{ repeat
until 1=2;}
dec(s);
lsec:=s+(h*longint(diskpar[drive,1]))+
(c*longint(diskpar[drive,0])*longint(diskpar[drive,1]));
lsec:=lsec+bno*2;
s:=lsec mod diskpar[drive,1];
c:=lsec div (longint(diskpar[drive,1])*longint(diskpar[drive,0]));
h:=(lsec-s-c*(longint(diskpar[drive,1])*longint(diskpar[drive,0])))
div diskpar[drive,1];
inc(s);
{ writeln('c=',c,' s=',s,' h=',h);}
{ repeat
until 1=2;}
regs.ah:=$02;
regs.al:=BLOCK_SIZE shr 9;
regs.es:=seg(buffer);
regs.bx:=ofs(buffer);
regs.ch:=c and $ff;
regs.cl:=s+((c shr 2) and $c0);
regs.dh:=h;
regs.dl:=$80+drive;
intr($13,regs);
if (regs.flags AND fcarry)>0 then
begin
writeln('error ',regs.ah,' during read_block');
halt;
end;
end;
procedure read_inode(node:longint;which_buf:word);
var
btr,group:longint;
offfs:word;
xtemp:word;
begin
if debug then writeln('want to read inode ',node);
dec(node);
group:=node div ipg;
btr:=(node mod ipg) div (BLOCK_SIZE div INODE_SIZE);
btr:=shitiofs+btr+group*bpg;
offfs:=node mod (BLOCK_SIZE div INODE_SIZE);
read_block(btr,buf[15,0],start);
if debug then
begin
writeln(' group ',group);
writeln(' btr ',btr);
writeln(' offfs ',offfs);
end;
for xtemp:=0 to inode_size-1 do
begin
mem[seg(inode_dat[which_buf]):ofs(inode_dat[which_buf])+xtemp]:=
buf[15,xtemp+offfs*INODE_SIZE];
end;
{ can surely optimise this ^^ }
end;
function compfn(fn:string):string;
var
found:integer;
best,orbest,ortempstr:string;
firstdiff:integer;
deflast:integer;
begin
if (conn) then
begin
writeln;
found:=0;
best:='';
valid:=false;
cblock:=0;
read_inode(inode,0);
deflast:=-1;
while (inode_dat[0].i_block[cblock]>0) and (cblock<EXT2_IND_BLOCK) do
begin
read_block(inode_dat[0].i_block[cblock],buf[2,0],start);
offs:=0;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
while (templ1<inodes) and (templ1>0) do
begin
templ2:=longint(buf[2,offs+6])+
(longint(buf[2,offs+7]) shl 8);
tempstr:='';
for y:=1 to templ2 do
tempstr:=tempstr+(chr(buf[2,offs+8+y-1]));
if (copy(tempstr,1,length(fn))=fn) then
begin
{ writeln;}
if deflast=-1 then
deflast:=length(tempstr);
{ writeln('deflast=',deflast);
writeln('"',best,'" (',length(best),')');}
writeln(tempstr{,' (',length(tempstr),')'});
orbest:=best;
ortempstr:=tempstr;
if best='' then
best:=tempstr
else
begin
if length(best)>length(tempstr) then
best:=copy(best,1,length(tempstr));
if length(tempstr)>length(best) then
tempstr:=copy(tempstr,1,length(best));
firstdiff:=1;
{ if (deflast<length(best)) then
deflast:=length(best);
if (deflast<length(tempstr)) then
deflast:=length(tempstr);
writeln('deflast=',deflast);}
while (firstdiff<length(best)) and
(best[firstdiff]=tempstr[firstdiff]) do
inc(firstdiff);
{ writeln('1stdiff=',firstdiff);
{ if firstdiff<deflast then deflast:=firstdiff;}
if (firstdiff=length(best)) and (length(orbest)=length(ortempstr)) then
begin
best:=copy(orbest,1,firstdiff-1);
if deflast>firstdiff then
begin
deflast:=firstdiff;
{ writeln(deflast,' 1');}
end
end
else
if firstdiff<length(best) then
begin
best:=copy(best,1,firstdiff-1);
if deflast>firstdiff-1 then
begin
deflast:=firstdiff-1;
{ writeln(deflast,' 2');}
end;
end
else
if (firstdiff=1) and (best[1]<>tempstr[1]) then
begin
deflast:=0;
{ writeln('0 3');}
best:='';
end;
end;
inc(found);
end;
templ1:=longint(buf[2,offs+4])+
(longint(buf[2,offs+5]) shl 8);
offs:=offs+templ1;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
end;
inc(cblock);
end;
if found>0 then
compfn:=best
else
compfn:=fn;
if deflast=0 then compfn:='';
{ writeln('deflast=',deflast);}
{ writeln(found,' matches found');}
end
else
begin
compfn:=fn;
writeln;
writeln('Not connected');
end;
end;
procedure my_readln(var v1:string);
var
ts,ts2:string;
is_end:boolean;
ch1,ch2:char;
tx:integer;
fntoex:string;
curcmd:cmdptr;
histidx:integer;
savecur:string;
xpos:integer;
begin
{ ts[0]:=#255;
ts[1]:=#255;
regs.ah:=$0a;
regs.ds:=seg(ts);
regs.dx:=ofs(ts);
intr($21,regs);
ts2[0]:=ts[1];
ts2:=copy(ts,2,ord(ts[1]));
v1:=ts2;}
{ curcmd:=cmdtail;}
histidx:=0;
savecur:='';
{ if curcmd<>nil then
writeln(curcmd^.cmd);}
write(prompt); clreol;
ts:='';
xpos:=1;
is_end:=false;
repeat
repeat
until keypressed;
ch1:=readkey;
ch2:=#0;
if (ch1=#0) and (keypressed) then ch2:=readkey;
if (ch1>=#32) and (ch2<=#255) and (length(ts)<255) then
begin
insert(ch1, ts, xpos);
write(copy(ts,xpos,length(ts)));
if xpos<length(ts) then
for tx:=xpos+1 to length(ts) do write(#8);
inc(xpos);
end;
{ write(ord(ch1),' ',ord(ch2));
{ ^A or Home }
if (ch1=#1) or (ch2='G') then
begin
if xpos>1 then
for tx:=1 to xpos-1 do write(#8);
xpos:=1;
end;
{ ^E or End }
if (ch1=#5) or (ch2='O') then
begin
if xpos<length(ts) then
write(copy(ts,xpos,length(ts)));
xpos:=length(ts)+1;
end;
{ ^C }
if (ch1=#3) then
begin
write('^C');
is_end:=true;
end;
{ bs }
if (ch1=#8) {and (length(ts)>0) }and (xpos>1) then
begin
delete(ts,xpos-1,1);
dec(xpos);
write(#8,copy(ts,xpos,length(ts)),' ',#8);
if xpos<length(ts) then
for tx:=xpos to length(ts) do write(#8);
end;
{ del }
if (ch2='S') and (xpos<=length(ts)) then
begin
delete(ts,xpos,1);
write(copy(ts,xpos,length(ts)),' ',#8);
if xpos<length(ts) then
for tx:=xpos to length(ts) do write(#8);
end;
{ cr }
if (ch1=#13) then
is_end:=true;
{ ^U }
if (ch1=#21) then
begin
if ts>'' then
for tx:=1 to length(ts) do
write(#8, ' ', #8);
ts:='';
xpos:=1;
end;
{ ^Z }
if (ch1=#26) then
begin
if canshell then
begin
write('^Z');
swapvectors;
exec(cli,'');
swapvectors;
write(prompt,ts);
xpos:=length(ts)+1;
end
end;
{ fncomp }
if (ch1=#4) or (ch1=#9) or (ch1=#27) then
begin
if pos(' ',ts)=0 then
begin
fntoex:=ts;
ts:='';
end
else
begin
fntoex:=copy(ts,pos(' ',ts)+1,length(ts));
ts:=copy(ts,1,pos(' ',ts));
end;
fntoex:=compfn(fntoex);
ts:=ts+fntoex;
write(prompt,ts);
xpos:=length(ts)+1;
end;
if ch1=#0 then
{ cup / pup }
if ((ch2='H') or (ch2='I')) and (cmdno>1) then
begin
if histidx=0 then savecur:=ts;
if ts>'' then
for tx:=1 to length(ts) do
write(#8, ' ', #8);
if histidx-1>-cmdno then dec(histidx);
curcmd:=cmdtail;
for tx:=1 to abs(histidx+1) do
curcmd:=curcmd^.prev;
ts:=curcmd^.cmd;
write(ts);
xpos:=length(ts)+1;
end
else
{ cdown / pdn }
if (ch2='P') or (ch2='Q') then
begin
if ts>'' then
for tx:=1 to length(ts) do
write(#8, ' ', #8);
if histidx<0 then inc(histidx);
if histidx<0 then
begin
curcmd:=cmdtail;
for tx:=1 to abs(histidx+1) do
curcmd:=curcmd^.prev;
ts:=curcmd^.cmd;
end
else
ts:=savecur;
write(ts);
xpos:=length(ts)+1;
end
else
{ cleft }
if ch2='K' then
begin
if xpos>1 then
begin
dec(xpos);
write(#8);
end;
end
else
{ cright }
if ch2='M' then
begin
if xpos<=length(ts) then
begin
write(ts[xpos]);
inc(xpos);
end;
end;
until is_end;
if ch1=#13 then
v1:=ts
else
v1:='';
writeln;
end;
procedure find_cli;
var
dirinf:searchrec;
s:pathstr;
begin
cli:='';
canshell:=false;
regs.ah:=$33;
regs.al:=$05;
intr($21,regs);
bootdev:=char((ord('A')+ord(regs.dl)-1));
findfirst(bootdev+':\'+shell,anyfile,dirinf);
if doserror=0 then
begin
cli:=bootdev+':\'+shell;
canshell:=true;
writeln(shell,' found in root of boot drive (',bootdev,':)...');
exit;
end;
writeln(shell,' not found in root of boot dir...');
s:=fsearch(shell,getenv('PATH'));
if s>'' then
begin
cli:=fexpand(s);
canshell:=true;
writeln(shell,' found in path...');
exit;
end;
writeln(shell,' not found in path...');
if (getenv('COMSPEC')>'') then
begin
cli:=getenv('COMSPEC');
canshell:=true;
writeln(shell,' found in COMSPEC...');
exit;
end;
end;
procedure change_color(s:string);
begin
{ if (inode_dat[1].i_mode and $40201)>0 then}
if (s[4]='x') or (s[7]='x') or (s[11]='x') then
textcolor(lightgreen)
else
textcolor(curcol);
{ dir }
{ if (inode_dat[1].i_mode and 16384)>0 then}
if (s[1]='d') then
textcolor(lightblue);
{ symlink }
{ if (inode_dat[1].i_mode and $f000)=$a000 then}
if (pos(' -> ',copy(s,namestart,255))>0) then
textcolor(lightcyan);
end;
procedure init;
var
x,y,z:word;
intcheck:pointer;
begin
{ screenwidth:=lo(windmax)+1;
screenheight:=hi(windmax)+1;}
screenwidth:=mem[$40:$4a];
screenheight:=mem[$40:$84]+1;
if mem[$40:$49]<>7 then
begin
color:=true;
curcol:=mem[$b800:80*25*2-1] and $f;
end;
writeln;
write(progname,' v',version,', ');
writeln(compiledate);
writeln(author);
writeln('http://freespace.virgin.net/andrew.wales/dft.html');
writeln('Please read all documentation...');
writeln;
write('Screen is ',screenwidth,'x',screenheight,' (');
if color then write('colour') else write('mono');
writeln(')');
writeln('DOS buffer is ',dosbufsize*BLOCK_SIZE,' bytes (',(dosbufsize*BLOCK_SIZE) div 1024,'kb)');
{ writeln('ext2fs to DOS transfer at ',(speeddiff*100):2:2,'% of Linux speed...');}
{ writeln((oldspeed*100):2:2,'% of speed of first version of ',progname,'...');}
writeln('Source is ',sourcebytes,' bytes, ',sourcelines,' lines...');
if debug then
begin
writeln('DEBUG VERSION...');
writeln;
end;
conn:=false;
partn:='';
xit:=false;
for x:=0 to maxdrive-1 do
for y:=0 to 3 do
for z:=0 to 15 do
partinf[x,y,z]:=0;
find_cli;
if canshell then
writeln('DOS shell enabled...')
else
writeln('No shell found, unable to shell...');
regs.ah:=$71;
regs.al:=$a0;
regs.cx:=$0010;
regs.flags:=regs.flags or fcarry;
intr($21,regs);
lfn95:=regs.ax<>$7100;
write('Long filenames ');
if not(lfn95) then write('not ');
write('supported (DOS ');
writeln(lo(dosversion),'.',hex8(hi(dosversion)),')');
if (lo(dosversion)>=7) and not(lfn95) then
writeln('Run in a Windows DOS box for long filename support');
e2found:=0;
if debug then
begin
writeln('Press a key...');
wait_key;
end;
hash:=true;
cmdhead:=nil;
cmdtail:=nil;
cmdno:=1;
end;
function confirm_ext2fs:boolean;
begin
if (os_type(partinf[drive,part,$4])<>'Linux native') then
begin
confirm_ext2fs:=false;
writeln('Partition is not defined as Linux native');
exit;
end
else
confirm_ext2fs:=true;
read_block(1,buf[0,0],start);
if (buf[0,$38]<>83) or (buf[0,$39]<>$EF) then
begin
confirm_ext2fs:=false;
writeln('Partition does not contain ext2fs magic number');
exit;
end;
end;
procedure dump_buf(bufno:word);
var
x,y:word;
tf:text;
begin
assign(tf,'dump_buf');
rewrite(tf);
for y:=0 to 63 do
begin
write(tf,'0x',hex16(y*16),' = ');
for x:=0 to 15 do
begin
write(tf,hex8(buf[bufno,y*16+x]),' ');
if x=7 then write(tf,': ');
end;
write(tf,' ');
for x:=0 to 15 do
begin
if buf[bufno,y*16+x]>32 then
write(tf,chr(buf[bufno,y*16+x]))
else
write(tf,' ');
if x=7 then write(tf,':');
end;
writeln(tf);
end;
close(tf);
end;
procedure disp_buf(bufno:word);
var
x,y:word;
begin
for y:=0 to 15 do
begin
write('0x',hex16(y*16),' = ');
for x:=0 to 15 do
begin
write(hex8(buf[bufno,y*16+x]),' ');
if x=7 then write(': ');
end;
write(' ');
for x:=0 to 15 do
begin
if buf[bufno,y*16+x]>32 then
write(chr(buf[bufno,y*16+x]))
else
write(' ');
if x=7 then write(':');
end;
writeln;
end;
end;
function convname(instr:string):string;
var
x,y:word;
header,extension:string;
begin
if instr[1]='.' then
instr[1]:='_';
x:=pos('.',instr);
if (x=0) and (length(instr)<9) then
begin
header:=instr;
extension:='';
convname:=header+'.'+extension;
exit;
end;
if (x=0) and (length(instr)>=9) then
begin
header:=copy(instr,1,8);
extension:='';
convname:=header+'.'+extension;
exit;
end;
if (x<=9) then
begin
header:=copy(instr,1,x-1);
extension:=copy(instr,x+1,3);
if (pos('.',extension)>0) then extension:=copy(extension,1,pos('.',
extension)-1);
convname:=header+'.'+extension;
exit;
end;
if (x>9) then
begin
header:=copy(instr,1,8);
extension:=copy(instr,x+1,3);
if (pos('.',extension)>0) then extension:=copy(extension,1,pos('.',
extension)-1);
convname:=header+'.'+extension;
exit;
end;
writeln('error during convname');
header:='default';
extension:='dat';
convname:=header+'.'+extension;
end;
procedure write_buf(diskbuffer:pointer;to_write:longint;var fl:file;totalsize:longint);
var
x,y:longint;
begin
if (to_write=(dosbufsize*BLOCK_SIZE)) then
blockwrite(fl,diskbuffer^,dosbufsize)
else
begin
blockwrite(fl,diskbuffer^,bufp+1);
reset(fl,1);
seek(fl,totalsize);
truncate(fl);
end;
end;
procedure memcpy(var source;var dest;to_copy:longint);
type
pd=array[0..BLOCK_SIZE-1] of byte;
var
a,b:^pd;
x,y:longint;
begin
a:=addr(source);
b:=addr(dest);
{ for x:=0 to to_copy-1 do
b^[x]:=a^[x];}
move(a^,b^,to_copy);
end;
function abortkey:boolean;
var
ch1,ch2:char;
begin
abortkey:=false;
if (keypressed) then
begin
ch1:=readkey;
if keypressed then ch2:=readkey;
abortkey:=(ch1=#27) or (ch1=#3);
end;
end;
procedure get_file(dltype:integer;fname:string;nnode:longint);
{ dltype ==1 => download file
dltype ==2 => copy to stdout }
var
total_bytes,bytes_left,to_write:longint;
dosname:string;
cblock,bbblock:longint;
outfile:file;
ind,ind2,ind3:longint;
st,et:longint;
tx,ty:word;
bout:byte;
numout:longint;
begin
if (shall_we_write) and (dltype=1) then
begin
dosname:=convname(fname);
if lfn95 then dosname:=fname;
writeln('Getting "',fname,'" from inode 0x',hex32(nnode),' as "',
dosname,'"');
if lfn95 then dosname:='DFTDL000.TMP';
assign(outfile,dosname);
rewrite(outfile,BLOCK_SIZE);
end;
{ writeln('heap size ',memavail);}
new(dosbuf);
bufp:=0;
bufcon:=0;
{ writeln('heap size ',memavail);}
{ end;}
read_inode(nnode,3);
total_bytes:=inode_dat[3].i_size;
bytes_left:=total_bytes;
if dltype=1 then writeln('must read ',total_bytes,' bytes');
ind:=-1;
ind2:=-1;
ind3:=-1;
cblock:=0;
st:=longint(memw[$40:$6e] shl 16)+longint(memw[$40:$6c]);
while (bytes_left>0) {and (inode_dat[3].i_block[cblock]>0)}
and (cblock<EXT2_N_BLOCKS) do
begin
if (cblock<EXT2_NDIR_BLOCKS) then
bbblock:=inode_dat[3].i_block[cblock];
if (cblock=EXT2_IND_BLOCK) and (ind=-1) then
begin
inc(ind);
read_block(inode_dat[3].i_block[cblock],buf[6,0],start);
end;
if (cblock=EXT2_IND_BLOCK) then
begin
bbblock:=(longint(buf[6,ind]))+
(longint(buf[6,ind+1]) shl 8)+
(longint(buf[6,ind+2]) shl 16)+
(longint(buf[6,ind+3]) shl 24);
inc(ind,4);
end;
if (cblock=EXT2_DIND_BLOCK) and (ind2=-1) then
begin
if (ind=-1) then
begin
inc(ind);
bbblock:=inode_dat[3].i_block[cblock];
read_block(bbblock,buf[7,0],start);
end;
inc(ind2);
bbblock:=(longint(buf[7,ind2]))+
(longint(buf[7,ind2+1]) shl 8)+
(longint(buf[7,ind2+2]) shl 16)+
(longint(buf[7,ind2+3]) shl 24);
read_block(bbblock,buf[6,0],start);
end;
if (cblock=EXT2_DIND_BLOCK) and (ind=BLOCK_SIZE) then
begin
inc(ind2,4);
bbblock:=(longint(buf[7,ind2]))+
(longint(buf[7,ind2+1]) shl 8)+
(longint(buf[7,ind2+2]) shl 16)+
(longint(buf[7,ind2+3]) shl 24);
read_block(bbblock,buf[6,0],start);
ind:=0;
end;
if (cblock=EXT2_DIND_BLOCK) then
begin
bbblock:=(longint(buf[6,ind]))+
(longint(buf[6,ind+1]) shl 8)+
(longint(buf[6,ind+2]) shl 16)+
(longint(buf[6,ind+3]) shl 24);
inc(ind,4);
end;
if (cblock=EXT2_TIND_BLOCK) then
begin
writeln('No support for triple indirect');
writeln('Silly way to transfer such a big file anyway.');
end;
if (hash) and (dltype=1) then
if bbblock=0 then
write(emptyblockchar)
else
write(realblockchar);
{ read_block(bbblock,buf[5,0],start);}
read_block(bbblock,dosbuf^[bufp*BLOCK_SIZE],start);
to_write:=block_size;
if (bytes_left<block_size) then
begin
bufcon:=bufcon+bytes_left;
if dltype=1 then
if shall_we_write then
begin
{ memcpy(buf[5],dosbuf^[bufp*BLOCK_SIZE],bytes_left);}
write_buf(dosbuf,bufcon,outfile,total_bytes);
end;
if dltype=2 then
begin
{ writeln('upper ',bufcon);
writeln('upper ',bytes_left);}
if (bufcon=(dosbufsize*BLOCK_SIZE)) then
numout:=bufcon
else
numout:=total_bytes mod (dosbufsize*BLOCK_SIZE);
for tx:=0 to numout-1 do
begin
bout:=dosbuf^[tx];
if bout=10 then write(#13);
write(chr(bout));
if abortkey then
begin
writeln(' (aborted');
exit;
end;
end;
{ writeln(' just wrote ',numout,' from upper');}
end;
{ write('la');}
end;
if shall_we_write then
begin
{ memcpy(buf[5],dosbuf^[bufp*BLOCK_SIZE],to_write);}
bufcon:=bufcon+to_write;
inc(bufp);
if (bufp=dosbufsize) or (bytes_left=BLOCK_SIZE) then
begin
if dltype=1 then
write_buf(dosbuf,bufcon,outfile,total_bytes);
if dltype=2 then
begin
{ writeln('lower ',bufcon);}
if (bufcon=(dosbufsize*BLOCK_SIZE)) then
numout:=bufcon
else
numout:=total_bytes;
for tx:=0 to numout-1 do
begin
bout:=dosbuf^[tx];
if bout=10 then write(#13);
write(chr(bout));
if abortkey then
begin
writeln(' (aborted)');
exit;
end;
end;
{ writeln(' just wrote ',numout,' from lower');}
end;
{ write('l');}
bufcon:=0;
bufp:=0;
end;
end;
bytes_left:=bytes_left-to_write;
if cblock<EXT2_NDIR_BLOCKS then
inc(cblock);
if (cblock=EXT2_IND_BLOCK) and (ind=BLOCK_SIZE) then
begin
inc(cblock);
ind:=-1;
end;
if (cblock=EXT2_DIND_BLOCK) and (ind2=BLOCK_SIZE) then
begin
inc(cblock);
ind:=-1;
ind2:=-1;
end;
end;
{ writeln;}
if (shall_we_write) and (dltype=1) then
begin
close(outfile);
if lfn95 then
begin
{ writeln('Renaming ',dosname,' to ',fname);}
dosname:=dosname+#0;
fname:=fname+#0;
regs.ax:=$7156;
regs.ds:=seg(dosname[1]);
regs.dx:=ofs(dosname[1]);
{ writeln(mem[regs.ds:regs.dx]);}
regs.es:=seg(fname[1]);
regs.di:=ofs(fname[1]);
{ regs.flags:=regs.flags and fcarry;}
intr($21,regs);
if (regs.flags and fcarry)>0 then
begin
writeln('error: ',doserr(regs.ax),'. hmm');
end;
{ writeln(hex16(regs.ax));}
end;
end;
et:=longint(memw[$40:$6e] shl 16)+longint(memw[$40:$6c]);
if dltype=1 then
begin
writeln('Transferred ',total_bytes/1024:2:2,'kb in ',(et-st)/18.2065:2:2,' seconds');
if (et>st) then writeln('Transfer rate of ',(total_bytes/1024)/((et-st)/18.2065):2:2,'kb/s');
end;
{ if shall_we_write then}
dispose(dosbuf);
{ writeln('heap size ',memavail);}
end;
function bufw(bufno,offs:integer):longint;
begin
bufw:=memw[seg(buf[bufno,offs]):ofs(buf[bufno,offs])];
end;
function bufl(bufno,offs:integer):longint;
begin
bufl:=meml[seg(buf[bufno,offs]):ofs(buf[bufno,offs])];
end;
procedure dumpfs(bufno:integer);
begin
writeln('Filesystem magic number: 0x',hex16(bufw(bufno,$38)));
writeln('Inode count: ',bufl(bufno,0));
writeln('Block count: ',bufl(bufno,4));
writeln('Reserved block count: ',bufl(bufno,8));
writeln('Block size: ',1024 shl bufl(bufno,$18));
{ writeln('Free blocks: ',bufl(bufno,12));}
{ writeln('Free inodes');}
writeln('Inodes per group: ',bufl(bufno,$28));
writeln('Mount count: ',bufw(bufno,$34));
writeln('Maximum mount count: ',bufw(bufno,$36));
end;
procedure addtohist(st:string);
var
cmdcurr,cmdcurr2:cmdptr;
begin
if length(st)>0 then
begin
new(cmdcurr);
cmdcurr^.cmd:=st;
cmdcurr^.prev:=nil;
cmdcurr^.next:=nil;
if cmdhead=nil then
begin
cmdhead:=cmdcurr;
cmdtail:=cmdcurr;
cmdcurr^.prev:=nil;
end
else
begin
cmdcurr2:=cmdhead;
while cmdcurr2^.next<>nil do
cmdcurr2:=cmdcurr2^.next;
cmdcurr2^.next:=cmdcurr;
cmdcurr^.prev:=cmdcurr2;
cmdtail:=cmdcurr;
end;
inc(cmdno);
end;
end;
procedure parse(st:string);
var
head,tail,tail2:string;
pipe:boolean;
tempfilename:string;
opf:text;
lshead,lscurr,lsprev:lslistptr;
sorted:boolean;
lastentry,tstr:string;
tempval1,tempval2:longint;
switches:string;
cmdcurr:cmdptr;
tempint:integer;
currcmd:cmdptr;
begin
if pos(st[1],histchar)=0 then addtohist(st);
pipe:=false;
tempfilename:='';
tail2:='';
if (pos('|',st)>0) then
begin
tail2:=copy(st,pos('|',st)+1,length(st));
st:=copy(st,1,pos('|',st)-1);
pipe:=true;
tempfilename:='$$DFT001.TMP';
end;
tempval2:=length(st);
for tempval1:=1 to length(st) do
begin
if (st[tempval1]<>' ') and (tempval1<tempval2) then
tempval2:=tempval1;
end;
st:=copy(st,tempval2,length(st));
if pos(st[1],commentchar)>0 then
exit;
if pos(st[1],histchar)>0 then
begin
{ write('History ');}
if pos(' ',st)=0 then st:=st+' ';
head:=copy(st,2,pos(' ',st)-2);
if pos(st[1],histchar)>0 then head:='-1'; { support for !! }
tempval1:=strtoint(head);
{ val(head,tempval1,tempint);}
tail:=copy(st,pos(' ',st),length(st));
if tail=' ' then tail:='';
{ writeln('''',head,''', ''',tail,'''');
writeln(tempval1);}
if (tempval1>=cmdno) or (tempval1=0) or (tempval1<=-cmdno) then
begin
writeln('No such history');
st:='';
end
else
begin
if tempval1>0 then
begin
currcmd:=cmdhead;
tempval2:=1;
while tempval2<tempval1 do
begin
currcmd:=currcmd^.next;
inc(tempval2);
end;
end
else
begin
currcmd:=cmdtail;
tempval2:=-1;
{ writeln(tempval2,'=',currcmd^.cmd);
{ writeln(currcmd^.next^.cmd);}
while tempval2>tempval1 do
begin
currcmd:=currcmd^.prev;
dec(tempval2);
end;
end;
head:=currcmd^.cmd;
st:=head+' '+tail;
writeln(st);
end;
end;
switches:='';
if pos(' ',st)=0 then
begin
head:=st;
tail:='';
end
else
begin
head:=copy(st,1,pos(' ',st)-1);
tail:=copy(st,pos(' ',st)+1,length(st));
end;
{ writeln('>',head,'< >',tail,'<');}
if tail[1]='-' then
begin
{ write('SWITHCES!');}
while (length(tail)>1) and (tail[2]>='a') and (tail[2]<='z') do
begin
{ writeln(length(tail),tail[2]);}
switches:=switches+tail[2];
{ tail:=tail[1]+copy(tail,3,length(tail));}
delete(tail,2,1);
{ write('boo!');}
{ writeln('>',tail,'<');}
end;
{ tail:=copy(tail,2,length(tail)-1);}
{ writeln('tttail=',tail);}
end;
{ writeln(1);}
{ writeln(switches);}
if head[1]=noechochar then
head:=copy(head,2,length(head)-1);
shall_we_write:=true;
if head='fakeget' then
begin
head:='get';
shall_we_write:=false;
end;
{ writeln('>',head,'< >',tail,'<');}
if (head='echo') or (head='printf') then
begin
writeln(tail);
end
else if (head='x') or (head='q') then
begin
halt;
end
else if (head='clear') or (head='cls') then
begin
clrscr;
end
else if (head='bye') or (head='logout') or (head='exit') or (head='quit') or (head='lo') then
begin
{ if (conn) then
writeln('Still connected to ',partn)
else
xit:=true;}
halt;
end
else if (head='hash') then
begin
hash:=not(hash);
write('Hash printing ');
if hash then
writeln('enabled...')
else
writeln('disabled...');
end
else if (head='open') or (head='open!') then
begin
{ if (conn) then
writeln('Still connected to ',partn)
else
begin}
if (length(tail)<>9) or (copy(tail,1,7)<>'/dev/hd') or
(tail[8]<'a') or (tail[8]>'d') or (tail[9]<'1') or (tail[9]>'4') then
begin
writeln('Invalid argument');
exit;
end
else
begin
{ writeln('Connecting to ',tail,'...');}
conn:=true;
partn:=tail;
drive:=ord(tail[8])-ord('a');
part:=ord(tail[9])-ord('1');
{ writeln('Drive ',drive,', partition ',part);
writeln('BIOS reports head=',diskpar[drive,0],', sect=',
diskpar[drive,1],', cyl=',diskpar[drive,2]);
writeln('Partition table says partition is of type ',
hex8(partinf[drive,part,$4]),': ',os_type(partinf[drive,part,$4]));}
start:=(longint(partinf[drive,part,$1]) shl 16)+
(longint(partinf[drive,part,$2]) shl 8)+
(partinf[drive,part,$3]);
fin:=(longint(partinf[drive,part,$5]) shl 16)+
(longint(partinf[drive,part,$6]) shl 8)+
(partinf[drive,part,$7]);
if not(confirm_ext2fs) then
begin
writeln('Continuing is NOT recommended...');
if head='open' then
begin
writeln('Open with open! command to override');
writeln('Not opened...');
conn:=false;
exit;
end;
if head='open!' then
begin
writeln('All errors from now on are YOUR problem, not mine...');
writeln('Honest!! Don''t bother me with this rubbish!');
end;
end;
pwd:='/';
{ read_block(0,buf[0,0],start);
disp_buf(0);}
{ df stuff is here }
read_block(1,buf[0,0],start);
inodes:=(longint(buf[0,$0]))+
(longint(buf[0,$1]) shl 8)+
(longint(buf[0,$2]) shl 16)+
(longint(buf[0,$3]) shl 24);
blocks:=(longint(buf[0,$4]))+
(longint(buf[0,$5]) shl 8)+
(longint(buf[0,$6]) shl 16)+
(longint(buf[0,$7]) shl 24);
fdz:=(longint(buf[0,$14]))+
(longint(buf[0,$15]) shl 8)+
(longint(buf[0,$16]) shl 16)+
(longint(buf[0,$17]) shl 24);
zonesize:=(longint(buf[0,$18]))+
(longint(buf[0,$19]) shl 8)+
(longint(buf[0,$1a]) shl 16)+
(longint(buf[0,$1b]) shl 24);
zonesize:=1024 shl zonesize;
bpg:=(longint(buf[0,$20]))+
(longint(buf[0,$21]) shl 8)+
(longint(buf[0,$22]) shl 16)+
(longint(buf[0,$23]) shl 24);
ipg:=(longint(buf[0,$28]))+
(longint(buf[0,$29]) shl 8)+
(longint(buf[0,$2a]) shl 16)+
(longint(buf[0,$2b]) shl 24);
blksz:=(1024 shl bufl(0,$18)) shr 9;
write('BLOCKSIZE ',blksz);
if blksz<>2 then
begin
writeln(' currently unsupported. sosumi.');
conn:=false;
exit;
end;
writeln;
{ grpblk:=bufl(0,$14)*2;}
{ grpblk:=bufl(0,$18)+1+bufl(0,$14);}
read_block(2,buf[0,0],start);
shitiofs:=(longint(buf[0,$08]))+
(longint(buf[0,$09]) shl 8)+
(longint(buf[0,$0a]) shl 16)+
(longint(buf[0,$0b]) shl 24);
writeln('shitiofs=',shitiofs);
{ disp_buf(0);}
inode:=2;
read_inode(inode,0);
if debug then
begin
writeln('Blocks per group=',bpg);
writeln('Inodes per group=',ipg);
end;
writeln('Connected to ',tail,'...');
end;
{ end;}
end
else if (head='close') then
begin
if (conn) then
writeln('Closed connection to ',partn)
else
writeln('Not connected');
conn:=false;
end
else if (head='ls') then
begin
if (conn) then
begin
cblock:=0;
x:=0;
{ writeln('heap size ',memavail);}
new(lshead);
lshead^.entry:='';
lshead^.link:=nil;
lscurr:=lshead;
read_inode(inode,0);
while (inode_dat[0].i_block[cblock]>0) and (cblock<EXT2_IND_BLOCK) do
begin
read_block(inode_dat[0].i_block[cblock],buf[2,0],start);
offs:=0;
{ templ1 is the inode of the current file we are reading through the
directory }
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
while (templ1<inodes) and (templ1>0) do
begin
lscurr^.entry:='';
lscurr^.link:=nil;
read_inode(templ1,1);
slink:=false;
if (inode_dat[1].i_mode and $f000)=$a000 then
slink:=true;
if (inode_dat[1].i_mode and 16384)>0 then
{ write(opf,'d')}
lscurr^.entry:=lscurr^.entry+'d'
else
{ write(opf,'-');}
lscurr^.entry:=lscurr^.entry+'-';
scratch[1]:=longint(inode_dat[1].i_mode) and $1ff;
scratch[2]:=256;
scratch[3]:=0;
while scratch[2]>0 do
begin
if (scratch[1] and scratch[2])>0 then
case scratch[3] mod 3 of
0:{write(opf,'r');}lscurr^.entry:=lscurr^.entry+'r';
1:{write(opf,'w');}lscurr^.entry:=lscurr^.entry+'w';
2:{write(opf,'x');}lscurr^.entry:=lscurr^.entry+'x';
end
else
{ write(opf,'-');}
lscurr^.entry:=lscurr^.entry+'-';
scratch[2]:=scratch[2] div 2;
inc(scratch[3]);
end;
{ write(opf,' ');}
lscurr^.entry:=lscurr^.entry+' ';
{ write(opf,inode_dat[1].i_links_count:3);
write(opf,' ');}
lscurr^.entry:=lscurr^.entry+inttostr(inode_dat[1].i_links_count,3);
lscurr^.entry:=lscurr^.entry+' ';
{ write(opf,nolead0(hex32(templ1)));
write(opf,' ');}
lscurr^.entry:=lscurr^.entry+nolead0(hex32(templ1));
lscurr^.entry:=lscurr^.entry+' ';
{ write(opf,inode_dat[1].i_size:10);
write(opf,' ');}
lscurr^.entry:=lscurr^.entry+inttostr(inode_dat[1].i_size,10);
lscurr^.entry:=lscurr^.entry+' ';
{ if not(pipe) and (color) then
change_color;}
templ1:=longint(buf[2,offs+6])+
(longint(buf[2,offs+7]) shl 8);
for y:=1 to templ1 do
if (buf[2,offs+8+y-1]>31) then
lscurr^.entry:=lscurr^.entry+chr(buf[2,offs+8+y-1]);
{ if pipe then
write(opf,chr(buf[2,offs+8+y-1]))
else
write(chr(buf[2,offs+8+y-1]));}
{ if not(pipe) and (color) then
textcolor(curcol);}
if slink then
{write(opf,' -> <symlink>');}
lscurr^.entry:=lscurr^.entry+' -> <symlink>';
{ writeln(opf);}
templ1:=longint(buf[2,offs+4])+
(longint(buf[2,offs+5]) shl 8);
offs:=offs+templ1;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
new(lscurr^.link);
lscurr:=lscurr^.link;
end;
inc(cblock);
end;
lscurr^.link:=nil;
sorted:=true;
lscurr:=lshead;
lastentry:='';
numentries:=0;
repeat
if (copy(lscurr^.entry,namestart,255)<lastentry) then
sorted:=false;
if (pos('a',switches)>0) or (lscurr^.entry[namestart]<>'.') then
inc(numentries);
lastentry:=copy(lscurr^.entry,namestart,255);
lscurr:=lscurr^.link;
until lscurr^.link=nil;
{XXXX}
{ writeln(numentries,' entries to list');}
{ if not(sorted) then write('not ');
writeln('sorted');}
if not(sorted) then
begin
{ writeln('attempting to sort...');}
repeat
sorted:=true;
lscurr:=lshead;
{ lastentry:=lscurr^.entry;}
lsprev:=lscurr;
lscurr:=lscurr^.link;
repeat
{ if (copy(lscurr^.entry,namestart,255)<lastentry) then
sorted:=false;
lastentry:=copy(lscurr^.entry,namestart,255);
lscurr:=lscurr^.link;}
if (copy(lscurr^.entry,namestart,255)<copy(lsprev^.entry,namestart,255)) then
begin
tstr:=lscurr^.entry;
lscurr^.entry:=lsprev^.entry;
lsprev^.entry:=tstr;
sorted:=false;
end;
lsprev:=lscurr;
lscurr:=lscurr^.link;
until lscurr^.link=nil;
until sorted;
end;
assign(opf,tempfilename);
rewrite(opf);
if (pos('l',switches)>0) then
begin
lscurr:=lshead;
repeat
if (pos('a',switches)>0) or (lscurr^.entry[namestart]<>'.') then
begin
write(opf,copy(lscurr^.entry,1,namestart-1));
if not(pipe) and (color) then
begin
change_color(lscurr^.entry);
write(copy(lscurr^.entry,namestart,255));
textcolor(curcol);
end
else
write(opf,copy(lscurr^.entry,namestart,255));
writeln(opf);
end;
lscurr:=lscurr^.link;
until lscurr^.link=nil;
end
else
begin
maxlen:=0;
lscurr:=lshead;
repeat
if (pos('a',switches)>0) or (lscurr^.entry[namestart]<>'.') then
if (maxlen<length(copy(lscurr^.entry,namestart,length(lscurr^.entry)))) then
begin
maxlen:=length(copy(lscurr^.entry,namestart,length(lscurr^.entry)));
end;
lscurr:=lscurr^.link;
until lscurr^.link=nil;
inc(maxlen,lsspace);
wide:=screenwidth div (maxlen);
if (maxlen*wide)>=screenwidth then dec(wide);
percol:=(numentries) div wide;
if (wide*percol<numentries) then inc(percol);
{XXXX}
{ writeln('maxlen ',maxlen);
writeln(percol,' percol');
writeln(wide,' wide');
write('12345678901234567890123456789012345678901234567890123456789012345678901234567890');}
perline:=0;
lscurr:=lshead;
cline:=0;
cacr:=0;
repeat
toent:=cacr*percol+cline;
cent:=0;
lscurr:=lshead;
if (toent>=numentries) and (numentries>0) then
begin
writeln(opf);
perline:=0;
cacr:=0;
inc(cline);
end
else
repeat
if ((pos('a',switches)>0) or (lscurr^.entry[namestart]<>'.')) then
begin
if toent=cent then
begin
if not(pipe) and (color) then
begin
change_color(lscurr^.entry);
write({cent,}copy(lscurr^.entry,namestart,length(lscurr^.entry)));
textcolor(curcol);
end
else
write(opf,copy(lscurr^.entry,namestart,length(lscurr^.entry)));
for x:=length(copy(lscurr^.entry,namestart,length(lscurr^.entry))) to maxlen-1 do
write(opf,' ');
perline:=perline+maxlen;
inc(cacr);
{ write(perline,' ',cline);}
if (perline+(maxlen)>screenwidth) then
begin
{ textcolor(curcol);}
writeln(opf);
perline:=0;
cacr:=0;
inc(cline);
end;
end;
inc(cent);
end;
lscurr:=lscurr^.link;
until lscurr^.link=nil;
{ if perline<>0 then
writeln(opf);}
until ((cline*wide)>=numentries) {or ((toent>=numentries) and (cacr=0))};
if (perline<>0) {and (numentries>0)} then
writeln(opf);
end;
close(opf);
{ now we can disassemble the linked list }
{ method suggested by dave }
lscurr:=lshead;
while lscurr^.link<>nil do
begin
lscurr:=lscurr^.link;
dispose(lshead);
lshead:=lscurr;
end;
dispose(lshead);
{ this was my old crap method of removing the linked list }
{ while lshead^.link<>nil do
begin
lscurr:=lshead;
lsprev:=lscurr;
while lscurr^.link<>nil do
begin
lsprev:=lscurr;
lscurr:=lscurr^.link;
end;
lsprev^.link:=nil;
dispose(lscurr);
end;
dispose(lshead);}
{ writeln('heap size ',memavail);}
if pipe then
begin
if canshell then
begin
head:=copy(head,2,length(head));
swapvectors;
if (head='') and (tail='') then
exec(cli,'')
else
exec(cli,'/c type '+tempfilename+'|'+tail2);
swapvectors;
if doserror<>0 then writeln('dos error ',doserror,': ',doserr(doserror));
end;
erase(opf);
end
end
else
writeln('Not connected');
end
else if (head='cdi') then
begin
if (conn) then
begin
inode:=strtoint(tail);
read_inode(inode,1);
pwd:='.../';
exit;
end
else
writeln('Not connected');
end
else if (head='cd') then
begin
if (conn) then
begin
if tail[1]='/' then
begin
inode:=2;
read_inode(inode,1);
pwd:='/';
if tail='/' then exit;
tail:=copy(tail,2,length(tail)-1);
end;
scratchstring:=tail;
while length(scratchstring)>0 do
begin
{ writeln('GOING ROUND...');}
if (pos('/',scratchstring))>0 then
tail:=copy(scratchstring,1,pos('/',scratchstring)-1)
else
tail:=scratchstring;
{ writeln('>',tail,'<');}
valid:=false;
cblock:=0;
read_inode(inode,0);
while (inode_dat[0].i_block[cblock]>0) and (cblock<EXT2_IND_BLOCK) do
begin
read_block(inode_dat[0].i_block[cblock],buf[2,0],start);
offs:=0;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
while (templ1<inodes) and (templ1>0) do
begin
templ2:=longint(buf[2,offs+6])+
(longint(buf[2,offs+7]) shl 8);
tempstr:='';
for y:=1 to templ2 do
tempstr:=tempstr+(chr(buf[2,offs+8+y-1]));
if (tempstr=tail) then
begin
read_inode(templ1,1);
what_we_want:=false;
if (inode_dat[1].i_mode and $4000)>0 then
what_we_want:=true;
if not(what_we_want) then
begin
writeln('not a directory');
scratchstring:='';
exit;
end
else
begin
{ writeln('match found at inode ',hex32(templ1));}
inode:=templ1;
valid:=true;
read_inode(inode,1);
if (tail='.') then
begin
end
else if (tail='..') then
begin
if (length(pwd)>1) and (pwd<>'.../') then
begin
pwd:=copy(pwd,1,length(pwd)-1);
while pwd[length(pwd)]<>'/' do
pwd:=copy(pwd,1,length(pwd)-1);
end;
end
else
pwd:=pwd+tail+'/';
end;
if length(scratchstring)=0 then exit;
end;
templ1:=longint(buf[2,offs+4])+
(longint(buf[2,offs+5]) shl 8);
offs:=offs+templ1;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
end;
{ end;}
inc(cblock);
end;
{ writeln('DONE IT');
writeln('>',scratchstring,'<');
writeln('>',tail,'<');}
if not(valid) then
begin
writeln(tail,': No such directory');
scratchstring:='';
exit;
end
else
begin
if (pos('/',scratchstring))=0 then
scratchstring:='';
if (pos('/',scratchstring))>0 then
scratchstring:=copy(scratchstring,pos('/',scratchstring)+1,length(scratchstring));
{ writeln('been round successfully');
writeln('>',scratchstring,'<');
writeln('>',tail,'<');}
end;
end;
end
else
writeln('Not connected');
end
else if (head='help') then
begin
writeln(progname,' v',version);
writeln;
writeln('Commands implemented: x q bye exit logout lo quit');
writeln(' clear cls');
writeln(' open open!');
writeln(' close');
writeln(' cd');
writeln(' cdi');
writeln(' ls');
writeln(' help');
writeln(' get');
writeln(' geti');
writeln(' block');
writeln(' "');
writeln(' df');
writeln(' echo');
writeln('showblock, debug, dumpfs, ofs, history, %, !, cat');
end
else if (head='df') then
begin
if (conn) then
begin
read_block(1,buf[8,0],start);
writeln('Filesystem 1024-blocks Used Available Capacity');
write('/dev/hd');
write(char(ord('a')+drive),char(ord('1')+part),' ');
tl1:=(longint(buf[8,$4]))+
(longint(buf[8,$5]) shl 8)+
(longint(buf[8,$6]) shl 16)+
(longint(buf[8,$7]) shl 24);
tl2:=(longint(buf[8,$8]))+
(longint(buf[8,$9]) shl 8)+
(longint(buf[8,$a]) shl 16)+
(longint(buf[8,$b]) shl 24);
tl3:=(longint(buf[8,$c]))+
(longint(buf[8,$d]) shl 8)+
(longint(buf[8,$e]) shl 16)+
(longint(buf[8,$f]) shl 24);
write(tl1:10);
write(tl1-(tl3{+tl2}):8);
write(tl3{-tl2}:9);
write(100-(((tl3{+tl2})*100) div tl1):6);
write('%');
writeln;
getdir(0,ts1);
write(copy(ts1,1,3));
tl1:=disksize(0) shr 10;
tl2:=diskfree(0) shr 10;
write(tl1:18);
write(tl1-tl2:8);
write(tl2:9);
write(100-((tl2*100) div tl1):6);
write('%');
writeln;
end
else
writeln('Not connected');
end
else if (head='geti') then
begin
if (conn) then
begin
templ1:=strtoint(copy(tail,1,pos(' ',tail)-1));
tail:=copy(tail,pos(' ',tail)+1,length(tail));
writeln(tail,' ',templ1);
get_file(1,tail,templ1);
exit;
end
else
writeln('Not connected');
end
else if (head='get') then
begin
if (conn) then
begin
valid:=false;
cblock:=0;
read_inode(inode,0);
while (inode_dat[0].i_block[cblock]>0) and (cblock<EXT2_IND_BLOCK) do
begin
read_block(inode_dat[0].i_block[cblock],buf[2,0],start);
offs:=0;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
while (templ1<inodes) and (templ1>0) do
begin
templ2:=longint(buf[2,offs+6])+
(longint(buf[2,offs+7]) shl 8);
tempstr:='';
for y:=1 to templ2 do
tempstr:=tempstr+(chr(buf[2,offs+8+y-1]));
if (tempstr=tail) then
begin
read_inode(templ1,1);
what_we_want:=false;
if (inode_dat[1].i_mode and $f000)=$8000 then
what_we_want:=true;
if not(what_we_want) then
writeln('not a regular file')
else
get_file(1,tempstr,templ1);
valid:=true;
exit;
end;
templ1:=longint(buf[2,offs+4])+
(longint(buf[2,offs+5]) shl 8);
offs:=offs+templ1;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
end;
inc(cblock);
end;
if not(valid) then writeln(tail,': No such file');
end
else
writeln('Not connected');
end
else if (head='block') then
begin
if (conn) then
begin
read_block(strtoint(tail),buf[14,0],start);
dump_buf(14);
writeln('Dumped block ',strtoint(tail),'...');
exit;
end
else
writeln('Not connected');
end
else if (head='showblock') then
begin
read_block(strtoint(tail),buf[14,0],start);
disp_buf(14);
end
else if (head='debug') then
begin
debug:=not(debug);
write('Debug is now o');
if debug then
writeln('n')
else
writeln('ff');
end
else if (head='dumpfs') then
begin
read_block(1,buf[14,0],start);
disp_buf(14);
dumpfs(14);
end
else if (head='ofs') then
begin
shitiofs:=strtoint(tail);
writeln('shitiofs=',shitiofs);
end
else if (head='history') then
begin
cmdcurr:=cmdhead;
templ1:=1;
while cmdcurr<>nil do
begin
writeln(templ1,':',cmdcurr^.cmd);
cmdcurr:=cmdcurr^.next;
inc(templ1);
end
end
else if (head='cat') then
begin
if (conn) then
begin
valid:=false;
cblock:=0;
read_inode(inode,0);
while (inode_dat[0].i_block[cblock]>0) and (cblock<EXT2_IND_BLOCK) do
begin
read_block(inode_dat[0].i_block[cblock],buf[2,0],start);
offs:=0;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
while (templ1<inodes) and (templ1>0) do
begin
templ2:=longint(buf[2,offs+6])+
(longint(buf[2,offs+7]) shl 8);
tempstr:='';
for y:=1 to templ2 do
tempstr:=tempstr+(chr(buf[2,offs+8+y-1]));
if (tempstr=tail) then
begin
read_inode(templ1,1);
what_we_want:=false;
if (inode_dat[1].i_mode and $f000)=$8000 then
what_we_want:=true;
if not(what_we_want) then
writeln('not a regular file')
else
get_file(2,tempstr,templ1);
valid:=true;
exit;
end;
templ1:=longint(buf[2,offs+4])+
(longint(buf[2,offs+5]) shl 8);
offs:=offs+templ1;
templ1:=longint(buf[2,offs])+
(longint(buf[2,offs+1]) shl 8)+
(longint(buf[2,offs+2]) shl 16)+
(longint(buf[2,offs+3]) shl 24);
end;
inc(cblock);
end;
if not(valid) then writeln(tail,': No such file');
end
else
writeln('Not connected');
end
{ DON'T PUT ANY COMMANDS AFTER THIS ONE BECAUSE IT ALTERS head }
else if (head<>'') and (head[1]='"') then
begin
if canshell then
begin
head:=copy(head,2,length(head));
swapvectors;
if (head='') and (tail='') then
exec(cli,'')
else
exec(cli,'/c '+head+' '+tail);
swapvectors;
if doserror<>0 then writeln('dos error ',doserror,': ',doserr(doserror));
end
else
writeln('No command interpreter found, shell unavailable...');
end
else
begin
if length(head)>0 then
writeln('Unknown command ''',head,'''');
end;
end;
procedure process_rcfile;
var
ifile:text;
line:string;
begin
if e2found=1 then
begin
writeln('Auto-opening...');
inp:='@open /dev/hd';
for x:=0 to maxdrive-1 do
for y:=0 to 3 do
if (os_type(partinf[x,y,$4])='Linux native') then
begin
inp:=inp+char(ord('a')+x)+char(ord('1')+y);
end;
if inp[1]<>noechochar then
writeln('# ',inp);
parse(inp);
end;
{$I-}
assign(ifile,rcfilename);
reset(ifile);
close(ifile);
{$I+}
if ioresult=0 then
begin
writeln('reading ',rcfilename,'...');
assign(ifile,rcfilename);
reset(ifile);
while not(eof(ifile)) do
begin
readln(ifile,inp);
if (inp<>'') and (pos(inp[1],commentchar)=0) then
begin
if inp[1]<>noechochar then
writeln('# ',inp);
parse(inp);
end;
end;
close(ifile);
end;
end;
begin
directvideo:=true;
init;
writeln('Scanning partition tables...');
for drive:=maxdrive-1 downto 0 do
begin
regs.ah:=$00;
regs.dl:=$80+drive;
intr($13,regs);
regs.ah:=$08;
regs.dl:=$80+drive;
intr($13,regs);
if ((regs.flags AND fcarry)=0) then
begin
diskpar[drive,0]:=regs.dh+1;
diskpar[drive,1]:=regs.cl and $3f;
diskpar[drive,2]:=regs.ch+((regs.cl and $c0) shl 2)+2;
regs.ah:=$02;
regs.al:=$01;
regs.es:=seg(buf[0]);
regs.bx:=ofs(buf[0]);
regs.ch:=0;
regs.cl:=1;
regs.dh:=0;
regs.dl:=$80+drive;
intr($13,regs);
for x:=0 to 3 do
begin
{ write('/dev/hd',
char(ord('a')+drive),char(ord('1')+x),' ');}
for y:=0 to 15 do
begin
partinf[drive,x,y]:=buf[0,$1be+x*$10+y];
{ write(hex8(partinf[drive,x,y]),' ');}
end;
{ writeln;}
{ write(os_type(partinf[drive,x,$4]));}
if (os_type(partinf[drive,x,$4])='Linux native') then
begin
{ write('ext2');}
writeln('ext2fs found on device /dev/hd',
char(ord('a')+drive),char(ord('1')+x));
inc(e2found);
end;
{ writeln;}
end;
end;
{ else
writeln('error ',regs.al,' reading drive /dev/hd',
char(ord('a')+drive));}
end;
rcfile:=true;
writeln('Number of ext2 filesystems found: ',e2found);
if e2found=0 then
writeln('No ext2 filesystems found???');
{ if e2found=1 then
rcfile:=true;}
if e2found>1 then
writeln('More than one ext2 filesystem found, cannot auto-open...');
if debug then
begin
writeln('Press a key...');
wait_key;
end;
if rcfile then
begin
process_rcfile;
end;
xit:=false;
while(not(xit)) do
begin
prompt:=progname+':';
{ write(progname);
write(':');}
if (conn) then
begin
if pwd='/' then
{ write(pwd,':')}
prompt:=prompt+pwd+':'
else
prompt:=prompt+copy(pwd,1,length(pwd)-1)+':';
{ write(copy(pwd,1,length(pwd)-1),':');}
{ if debug then write(hex32(inode));}
if debug then prompt:=prompt+hex32(inode);
end;
{ write(cmdno,':');}
prompt:=prompt+inttostr(cmdno,0)+':';
{ clreol;}
{ write('# ');}
prompt:=prompt+'# ';
my_readln(inp);
{ writeln(length(inp),' >',inp,'<');}
parse(inp);
end;
end.