srvctrl.pas

Source code Delphi FTP-server

            begin
            SendString('421 No home directory.');
            Terminate;
            exit;
            end;
          end;
        SendString('230 Welcome');
        Pwd:=par;
        State:=st_DIALOG;
        LogMessage(CS_LOGIN);
        end;
      3 : { ACCT }
        begin
        SendString('200 ACCT was not needed');
        end;
      4 : { CWD  }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        if par[1] in ['/','\'] then
          s1:='/'
        else
          s1:=CDir;
        while BitPath(par,s) do
          begin
          if s <> '.' then
            begin
            if s = '..' then
              s1:=UpDir(s1)
            else
              s1:=DownDir(s1,s);
            end;
          end;
        i:=Parent.DirList.IndexOf(s1);
        if i >= 0 then
          begin
          Ent:=false;
          if Parent.UserList.RootByName(Usr) then
            Ent:=true;
          if Parent.DirList.UID[i] = Parent.UserList.UIDByName(Usr) then
            Ent:=true;
          if Parent.UserList.InGroupByName(Usr,Parent.DirList.GID[i]) then
            begin
            if da_GrEnter in Parent.DirList.Attrib[i] then
              Ent:=true;
            end;
          if da_Enter in Parent.DirList.Attrib[i] then
            Ent:=true;
          if Ent then
            begin
            CDir:=s1;
            SendString('250 Entering "'+CDir+'"');
            LogMessage(CS_CHDIR);
            end
          else
            SendString('550 Access denied');
          end
        else
          SendString('550 Directory not found');
        end;
      5 : { CDUP }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        s1:=UpDir(CDir);
        i:=Parent.DirList.IndexOf(s1);
        if i >= 0 then
          begin
          Ent:=false;
          if Parent.UserList.RootByName(Usr) then
            Ent:=true;
          if Parent.DirList.UID[i] = Parent.UserList.UIDByName(Usr) then
            Ent:=true;
          if Parent.UserList.InGroupByName(Usr,Parent.DirList.GID[i]) then
            begin
            if da_GrEnter in Parent.DirList.Attrib[i] then
              Ent:=true;
            end;
          if da_Enter in Parent.DirList.Attrib[i] then
            Ent:=true;
          if Ent then
            begin
            CDir:=s1;
            SendString('250 Entering "'+CDir+'"');
            LogMessage(CS_CHDIR);
            end
          else
            SendString('550 Access denied');
          end
        else
          SendString('550 Directory not found');
        end;
      6 : { SMNT }
        begin
        SendString('502 Command not implemented');
        end;
      7 : { QUIT }
        begin
        SendString('200 See you later.');
        LogMessage(CS_LOGOUT);
        Terminate;
        exit;
        end;
      8 : { REIN }
        begin
        CDir:='';
        State:=st_LOGIN;
        SendString('220 Service ready for new user.');
        LogMessage(CS_LOGOUT);
        end;
      9 : { PORT }
        begin
        if State <> st_DIALOG then
          begin
          SendString('503 Not now (not logged in or data connection already open)');
          Continue;
          end;
        ent:=false;
        for i:=1 to 4 do
          begin
          val(copy(par,1,pos(',',par)-1),addr[i],i1);
          if i1 > 0 then
            begin
            ent:=true;
            break;
            end;
          par:=copy(par,pos(',',par)+1,255);
          end;
        if ent then
          begin
          SendString('501 Parameter syntax error');
          continue;
          end;
        val(copy(par,1,pos(',',par)-1),tprt,i1);
        if i1 > 0 then
          begin
          SendString('501 Parameter syntax error');
          continue;
          end;
        val(copy(par,pos(',',par)+1,255),tp2,i1);
        if i1 > 0 then
          begin
          SendString('501 Parameter syntax error');
          continue;
          end;
        tprt:=tprt*256+tp2;
        if not Parent.AllowRedirect then
          begin
          for i:=1 to 4 do
            if addr[i] <> RAddr[i] then
              begin
              ent:=true;
              break;
              end;
          if ent then
            begin
            SendString('501 Parameter syntax error');
            continue;
            end;
          end;
        RAddr:=addr;
        DPort:=tprt;
        Pasv:=false;
        SendString('200 PORT command ok.');
        end;
      10: { PASV }
        begin
        if State <> st_DIALOG then
          begin
          SendString('503 Not now (not logged in or data connection already open)');
          Continue;
          end;
        LPort:=random(15000)+999;
        if DCon then
          begin
          DTrd.Terminate;
          TOut:=TTimeout.create(50,@Brk);
          while DCon and not Brk do;
          if Brk then
            HandleError(ES_DRUN)
          else
            TOut.terminate;
          end;
        Pasv:=true;
        DTrd:=TDataThread.Create('IDLE',RAddr,Pasv,di_IDLE,CMode,CData,LPort,
          Parent,nil,Marker,DConExit,ControlLog,Usr,Pwd,CDir);
        DCon:=true;
        sleep(100);
        SendString('227 Entering Passive Mode ('+format('%d,%d,%d,%d,%d,%d',
          [HAddr[1],HAddr[2],HAddr[3],HAddr[4],hi(LPort),lo(LPort)])+')');
        end;
      11: { TYPE }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        if par <> '' then
          case par[1] of
            'A','a':
              begin
              CMode:=md_ASCII;
              SendString('200 Mode changed to ASCII');
              end;
            'I','i':
              begin
              CMode:=md_IMAGE;
              SendString('200 Mode changed to BINARY');
              end;
            else
              begin
              SendString('504 Command not implemented for this type');
              end;
            end
          else
            SendString('501 Syntax error');
        end;
      12: { STRU }
        begin
        SendString('502 Command not implemented');
        end;
      13: { MODE }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        if par <> '' then
          case par[1] of
            'S','s':
              begin
              CData:=dt_STREAM;
              SendString('200 Data type changed to STREAM');
              end;
            else
              begin
              SendString('504 Command not implemented for this type');
              end;
            end
          else
            SendString('501 Syntax error');
        end;
      14: { RETR }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        { Checking file permissions }
        par:=alltrim(par);
        if par[length(par)] in ['/','\'] then
          begin
          SendString('450 No file name specified');
          continue;
          end;
        s:=par;
        while (s <> '') and not (s[length(s)] in ['\','/']) do dec(byte(s[0]));
        s1:=copy(par,length(s)+1,255);
        if s = '' then
          s:=CDir
        else
          if not (s[1] in ['/','\']) then
            s:=addslash(CDir)+s;
        s:=NormalizePath(s);
        i:=Parent.DirList.IndexOf(s);
        if i < 0 then
          begin
          SendString('450 Directory not found');
          continue;
          end;
        if not Parent.UserList.RootByName(Usr) then
          begin
          if Parent.DirList.UID[i] <> Parent.UserList.UIDByName(Usr) then
            begin
            if Parent.UserList.InGroupByName(Usr,Parent.DirList.GID[i]) then
              begin
              if not (da_GrReadFiles in Parent.DirList.Attrib[i]) then
                begin
                SendString('550 Permission denied');
                continue;
                end;
              end
            else
              if not (da_ReadFiles in Parent.DirList.Attrib[i]) then
                begin
                SendString('550 Permission denied');
                continue;
                end;
            end;
          end;
        s:=addslash(Parent.DirList.Alias[i])+s1;
        { Calculating timeout }
        if FindFirst(s,faArchive+faHidden+faReadOnly,SR) <> 0 then
          begin
          SendString('450 File not found');
          continue;
          end;
        lto:=trunc(SR.Size/10);
        { Run the data process }
        s1:='';
        case CMode of
          md_ASCII: s1:='ASCII';
          md_IMAGE: s1:='BINARY';
          end;
        if DCon then
          begin
          DTrd.GotWork(s,di_SEND,CMode,CData,nil,Marker);
          SendString('125 Sending file "'+par+'" in '+s1+' mode');
          end
        else
          begin
          DTrd:=TDataThread.Create(s,RAddr,Pasv,di_SEND,CMode,CData,DPort,Parent
            ,nil,Marker,DConExit,ControlLog,Usr,Pwd,CDir);
          DCon:=true;
          SendString('150 Sending file "'+par+'" in '+s1+' mode');
          end;
        if DTrd.Error = 0 then
          begin
          State:=st_DATA;
          TOut:=TTimeout.create(lto,@Brk);
          LogMessage(CS_ULOAD);
          end
        else
          begin
          DTrd.Terminate;
          SendString('425 Can''t open data connection.');
          end;
        end;
      15: { STOR }
        begin
        if (State <> st_DIALOG) and (State <> st_DATA) then
          begin
          SendString('530 Not logged in');
          Continue;
          end;
        { Checking the directory permissions }
        par:=alltrim(par);
        if par[length(par)] in ['/','\'] then
          begin
          SendString('450 No file name specified');
          continue;
          end;
        s:=par;
        while (s <> '') and not (s[length(s)] in ['\','/']) do dec(byte(s[0]));
        s1:=copy(par,length(s)+1,255);
        if s = '' then
          s:=CDir
        else
          if not (s[1] in ['/','\']) then
            s:=addslash(CDir)+s;
        s:=NormalizePath(s);
        i:=Parent.DirList.IndexOf(s);
        if i < 0 then
          begin
          SendString('450 Directory not found');
          continue;
          end;
        if not Parent.UserList.RootByName(Usr) then
          begin
          if Parent.DirList.UID[i] <> Parent.UserList.UIDByName(Usr) then
            begin
            if Parent.UserList.InGroupByName(Usr,Parent.DirList.GID[i]) then
              begin
              if not (da_GrWriteFiles in Parent.DirList.Attrib[i]) then
                begin
                SendString('550 Permission denied');
                continue;
                end;
              end
            else
              if not (da_WriteFiles in Parent.DirList.Attrib[i]) then
                begin
                SendString('550 Permission denied');
                continue;
                end;
            end;
          end;
        { Run the data process }
        s:=addslash(Parent.DirList.Alias[i])+s1;
        s1:='';
        case CMode of
          md_ASCII: s1:='ASCII';
          md_IMAGE: s1:='BINARY';
          end;
        if DCon then
          begin
          DTrd.GotWork(s,di_RECEIVE,CMode,CData,nil,Marker);
          SendString('125 Gonna receive file in '+s1+' mode');
          end
        else
          begin
          DTrd:=TDataThread.Create(s,RAddr,Pasv,di_RECEIVE,CMode,CData,DPort,
            Parent,nil,Marker,DConExit,ControlLog,Usr,Pwd,CDir);
          DCon:=true;
          SendString('150 Gonna receive file in '+s1+' mode');
          end;
        if DTrd.Error = 0 then
          begin
          State:=st_DATA;
          TOut:=TTimeout.create(72000,@Brk);